# load libraries
library(tidyverse)
library(here)
library(ggpmisc)
library(ggrepel)
library(ggbeeswarm)Cleaning Data:
# Read the data
tl <- read_csv(here("data/Tulai_Lithic_Assamblage.csv"))
# Create a new data frame with renamed columns
tl1 <- tl
names(tl1)[1:2] <- c("lithic_id",
"TA")
# modify TA column
tl1 <- tl1 %>%
# Remove everything within brackets
mutate(TA = str_remove_all(TA,
"\\(.*\\)")) %>%
# Add slash between TA and numbers
mutate(TA = str_replace_all(TA,
"TA([0-9]+)",
"TA/\\1")) %>%
# Add slash between numbers
mutate(TA = str_replace_all(TA,
"([0-9]+)/([0-9]+)", "\\1/\\2")) %>%
# fill NA values in TA column
tidyr::fill(TA, .direction = "down") %>%
# Prepend 'TA/' to numbers
mutate(TA = if_else(str_detect(TA,
"^[0-9]+$"),
paste0("TA/",
TA),
TA)) %>%
# Remove all non-alphanumeric characters
mutate(TA = str_replace_all(TA,
"[^[:alnum:] /]",
"")) %>%
# Make all text lowercase
mutate(TA = tolower(TA)) %>%
# Remove white space
mutate(TA = str_replace_all(TA, " ", "")) %>%
# Separate 'TA' column into 'area' and 'depth' columns
separate(TA, into = c("area",
"depth"),
sep = "/",
remove = FALSE,
convert = TRUE) %>%
# Convert 'depth' to numeric
mutate(depth = as.numeric(depth)) %>%
# Create depth ranges
mutate(depth = case_when(
depth == 3 ~ "0-30 cm",
depth == 34 ~ "30-40 cm",
depth == 45 ~ "40-50 cm",
depth == 56 ~ "50-60 cm",
depth == 67 ~ "60-70 cm",
depth == 72 ~ "70-120 cm",
depth == 125 ~ "120-150 cm",
depth == 158 ~ "150-180 cm",
depth == 189 ~ "180-190 cm",
depth == 190 ~ "190-200 cm",
depth == 201 ~ "200-210 cm",
depth == 212 ~ "210-220 cm",
depth == 223 ~ "220-230 cm",
depth == 234 ~ "230-240 cm",
depth == 235 ~ "230-250 cm",
depth == 256 ~ "250-260 cm",
depth == 267 ~ "260-270 cm",
depth == 72 ~ "70-120 cm",
depth == 1 ~ "0-10 cm",
depth == 2 ~ "0-20 cm",
depth == 13 ~ "10-30 cm",
depth == 19 ~ "10-90 cm",
depth == 23 ~ "20-30 cm",
depth == 34 ~ "30-40 cm",
depth == 45 ~ "40-50 cm",
depth == 51 ~ "50-100 cm",
depth == 56 ~ "50-60 cm",
depth == 57 ~ "50-70 cm",
depth == 89 ~ "80-90 cm",
depth == 91 ~ "90-100 cm",
depth == 101 ~ "100-110 cm",
depth == 112 ~ "110-120 cm",
depth == 123 ~ "120-130 cm",
depth == 124 ~ "120-140 cm",
depth == 23 ~ "20-30 cm",
depth == 46 ~ "40-60 cm",
depth == 78 ~ "70-80 cm",
depth == 235 ~ "230-250 cm",
depth == 12 ~ "10-20 cm",
depth == 90 ~ "90-100 cm",
TRUE ~ as.character(depth)
)) %>%
separate(depth,
into = c("upper",
"lower"),
sep = "-",
remove = FALSE,
convert = TRUE) %>%
mutate(lower = parse_number(lower)) %>%
rowwise() %>%
mutate(midpoint = mean(c(upper, lower))) %>%
# create 'layer' column
mutate(layer = case_when(
area == "tp1" & depth == "0-10 cm" ~ "c",
area == "tp1" & depth == "0-20 cm" ~ "c",
area == "tp1" & depth == "10-30 cm" ~ "c",
area == "tp1" & depth == "10-90 cm" ~ "c",
area == "tp1" & depth == "20-30 cm" ~ "c",
area == "tp1" & depth == "30-40 cm" ~ "c",
area == "tp1" & depth == "40-50 cm" ~ "c",
area == "tp1" & depth == "50-100 cm" ~ "c",
area == "tp1" & depth == "50-60 cm" ~ "c",
area == "tp1" & depth == "50-70 cm" ~ "c",
area == "tp1" & depth == "80-90 cm" ~ "c",
area == "tp1" & depth == "90-100 cm" ~ "c",
area == "tp1" & depth == "100-110 cm" ~ "c",
area == "tp1" & depth == "110-120 cm" ~ "c",
area == "tp1" & depth == "120-130 cm" ~ "c",
area == "tp1" & depth == "120-140 cm" ~ "c",
area == "d1" & depth == "0-20 cm" ~ "c",
area == "d1" & depth == "20-30 cm" ~ "c",
area == "d1" & depth == "40-60 cm" ~ "a",
area == "d1" & depth == "50-60 cm" ~ "a",
area == "d1" & depth == "60-70 cm" ~ "a",
area == "d1" & depth == "70-80 cm" ~ "a",
area == "ta" & depth == "0-30 cm" ~ "e",
area == "ta" & depth == "30-40 cm" ~ "e",
area == "ta" & depth == "40-50 cm" ~ "e",
area == "ta" & depth == "50-60 cm" ~ "e",
area == "ta" & depth == "60-70 cm" ~ "e",
area == "ta" & depth == "70-120 cm" ~ "d",
area == "ta" & depth == "120-150 cm" ~ "d",
area == "ta" & depth == "150-180 cm" ~ "d",
area == "ta" & depth == "180-190 cm" ~ "d",
area == "ta" & depth == "190-200 cm" ~ "d",
area == "ta" & depth == "200-210 cm" ~ "d",
area == "ta" & depth == "210-220 cm" ~ "d",
area == "ta" & depth == "220-230 cm" ~ "d",
area == "ta" & depth == "230-240 cm" ~ "d",
area == "ta" & depth == "230-250 cm" ~ "d",
area == "ta" & depth == "250-260 cm" ~ "d",
area == "ta" & depth == "260-270 cm" ~ "d",
TRUE ~ NA_character_
))
# Remove specific columns
tl1 %>%
select(-c("AREA",
"DEPTH (cm)",
"Raw Material",
"Colour/Grain/Opacity",
"Pattern"))# A tibble: 3,920 × 36
# Rowwise:
lithic_id TA area depth upper lower `Cortex (%)` `Weight (g)`
<chr> <chr> <chr> <chr> <int> <dbl> <dbl> <lgl>
1 1 ta/34 ta 30-40 cm 30 40 0 NA
2 2 ta/34 ta 30-40 cm 30 40 0 NA
3 3 ta/34 ta 30-40 cm 30 40 0 NA
4 4 ta/34 ta 30-40 cm 30 40 0 NA
5 5 ta/34 ta 30-40 cm 30 40 0 NA
6 6 ta/34 ta 30-40 cm 30 40 0 NA
7 9 ta/34 ta 30-40 cm 30 40 0 NA
8 10 ta/34 ta 30-40 cm 30 40 0 NA
9 11 ta/34 ta 30-40 cm 30 40 10 NA
10 12 ta/34 ta 30-40 cm 30 40 0 NA
# ℹ 3,910 more rows
# ℹ 28 more variables: `Length (mm)` <dbl>, `Width (mm)` <dbl>,
# `Thickness (mm)` <chr>, `Bulb Thickness (mm)` <chr>,
# `Platform Thickness (mm)` <chr>, `platform Length (mm)` <chr>,
# Eraillure <chr>, Typology <chr>, Utilization <chr>, Retouch <dbl>,
# `Retouch Position` <chr>, `Retouch Localization` <chr>,
# `Retouch Distribution` <chr>, `Retouch Intensity` <chr>, …# exploring Data
tl1 %>%
group_by(midpoint) %>%
tally() %>%
drop_na(midpoint) %>%
ggplot() +
aes(midpoint, n) +
geom_col()
# exploring Data
tl1 %>%
group_by(layer) %>%
tally() %>%
drop_na(layer) %>%
ggplot() +
aes(layer, n) +
geom_col()
# exploring Data
tl2 <- tl1 %>%
mutate(
Blank = case_when(
Breakage %in% c("0", "1", NA_character_) ~ Blank,
TRUE ~ Breakage
)
)# Cleaning Blank column
tl2 <- tl2 %>%
mutate(
Blank = str_to_lower(Blank),
Blank = str_trim(Blank),
Blank = str_replace_all(Blank, "[./]", "-"),
Blank = str_replace_all(Blank, "\\s*-\\s*", "-")
) %>%
mutate(Blank = case_when(
Blank == "peo" ~ "bladelet-pro",
Blank == "pro" ~ "bladelet-pro",
Blank == "bladelet-dis" ~ "bladelet-dis",
Blank == "microblade" ~ "bladelet-complete",
Blank == "microblade-pro" ~ "bladelet-pro",
Blank == "microblade-med" ~ "bladelet-med",
Blank == "micrpblade-dis" ~ "bladelet-dis",
Blank == "dis" ~ "bladelet-dis",
Blank == "bladelrt-med" ~ "bladelet-med",
Blank == "bladelet-mes" ~ "bladelet-med",
Blank == "bladelet-,ed" ~ "bladelet-med",
Blank == "bladelet-bladelet-med" ~ "bladelet-med",
Blank == "medial" ~ "bladelet-med",
Blank == "bladelet-bladelet-pro" ~ "bladelet-pro",
Blank == "bladelert-pro" ~ "bladelet-pro",
Blank == "microblade-medial" ~ "bladelet-med",
Blank == "nicroblade-pro" ~ "bladelet-pro",
Blank == "microblade-?" ~ "bladelet-complete",
Blank == "med" ~ "bladelet-med",
Blank == "bladeler-pro" ~ "bladelet-pro",
Blank == "microblade-dis" ~ "bladelet-dis",
Blank == "microblde-dis" ~ "bladelet-dis",
Blank == "bladlet-pro" ~ "bladelet-pro",
Blank == "indistinct" ~ "bladelet-med",
Blank == "flake" ~ "flake-complete",
Blank == "dladelet-pro" ~ "bladelet-pro",
Blank == "dladelet-pro" ~ "bladelet-pro",
Blank == "bldelet-bladelet-pro" ~ "bladelet-pro",
Blank == "bldelet-pro" ~ "bladelet-pro",
Blank == "nicroblade-pro" ~ "bladelet-pro",
Blank == "microblade-?" ~ "bladelet-med",
Blank == "bladelt-pro" ~ "bladelet-pro",
Blank == "bladeket-med" ~ "bladelet-med",
Blank == "nicroblade-pro" ~ "bladelet-pro",
Blank == "blaelet" ~ "bladelet-complete",
Blank == "bladele-med" ~ "bladelet-med",
Blank == "bladelet-nearly complete" ~ "bladelet-complete",
Blank == "blade-nearly complete" ~ "blade-complete",
Blank == "bladelet-?" ~ "bladelet-complete",
Blank == "flake?" ~ "flake-complete",
Blank == "micrpblade-dis" ~ "bladelet-dis",
Blank == "blaelet-med" ~ "bladelet-med",
Blank == "blaedlet-pro" ~ "bladelet-pro",
Blank == "bladelt-pro" ~ "bladelet-pro",
Blank == "bladelet-nearly complete"~ "bladelet-complete",
Blank == "microblade-med" ~ "bladelet-med",
Blank == "bldelet-bladelet-pro" ~ "bladelet-pro",
Blank == "bldelet-flake" ~ "blade-complete",
Blank == "mwdial" ~ "bladelet-med",
Blank == "blade" ~ "blade-complete",
Blank == "bladelt" ~ "bladelet-complete",
Blank == "bladlet" ~ "bladelet-complete",
Blank == "bladlet-med" ~ "bladelet-med",
Blank == "bladelt-med" ~ "bladelet-med",
Blank == "flaje" ~ "flake",
Blank == "flke" ~ "flake",
Blank == "bladelet" ~ "bladelet-complete",
Blank == "NA" ~ "bladelet-",
Blank == "thick flake" ~ "flake",
Blank == "flke-mid" ~ "flake-med",
Blank == "flake-blade" ~ "flake",
Blank == "angular flake?" ~ "flake",
Blank == "flake-prox" ~ "flake-pro",
Blank == "fklae-dis" ~ "flake-dis",
Blank == "bladelete" ~ "bladelet",
Blank == "NA" ~ NA_character_,
TRUE ~ Blank
)) %>%
mutate(Blank = na_if(Blank, ""))
rev(sort(table(tl2$Blank)))
bladelet-pro bladelet-med bladelet-dis
1461 660 333
bladelet-complete bladelet-mid flake-complete
299 279 179
blade-med blade-complete blade-pro
83 76 71
blade-dis blade-mid flake-dis
42 35 26
flake-med flake flake-pro
14 13 10
baldelet-mid bladelete-pro bladele-pro
8 5 5
baldelet-pro ? bladelet-po
4 4 3
flake-mid debri chunk
2 2 2
bldelet-mid bladrlet-mid bladlet-mid
2 2 2
bladelt-dis bladelet-prp bladelet pro
2 2 2
baldelet-dis vladelet-mid naturally backed flake
2 1 1
naturally backed bladelet ladelet-pro flakemed
1 1 1
falke-blade falke dihedral
1 1 1
denticulate? chip? blsadelet-pro
1 1 1
blelt-mid bldelety-pro blaelet-pro
1 1 1
bladlet-dis bladerlet bladelte-mid
1 1 1
bladelte-dis bladelt-mid bladeletmid
1 1 1
bladelet0pro bladelet-ro bladelet-meid
1 1 1
bladelet-md bladelet-is bladelet-ed
1 1 1
bladeler-mid bladele bladel-dis
1 1 1
blade;et-pro blade;et blade-pro-mid
1 1 1
blade-md blade-flake bladaelet-mid
1 1 1
baldelet-med baldelet badelet-med
1 1 1
bade-dis
1 # BM: still many typos and unusual categories in here, why is that? Can they be fixed?
tl3 <- tl2 %>%
separate(Blank,
into = c("Blank2", "Blank_part"),
sep = "-",
remove = FALSE,
convert = TRUE)
na_rows <- which(is.na(tl2$Blank))
print(na_rows) [1] 21 355 367 368 369 370 489 490 491 492 493 494 495 496 497
[16] 498 543 572 573 644 647 648 649 650 651 652 653 654 694 721
[31] 722 723 724 725 726 727 843 851 853 856 857 858 862 863 866
[46] 867 871 872 874 875 876 877 880 881 882 883 884 953 954 1030
[61] 1031 1070 1071 1072 1073 1075 1076 1077 1170 1310 1311 1312 1443 1444 1445
[76] 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460
[91] 1461 1462 1463 1464 1465 1540 1599 1604 1605 1611 1614 1622 1624 1626 1912
[106] 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 2132 2133 2134 2135 2136
[121] 2137 2139 2140 2141 2142 2143 2144 2146 2148 2150 2151 2152 2153 2154 2155
[136] 2156 2157 2158 2159 2160 2161 2162 2237 2244 2251 2253 2274 2339 2340 2346
[151] 2365 2391 2398 2403 2422 2425 2435 2436 2437 2438 2439 2440 2441 2442 2443
[166] 2444 2445 2446 2447 2448 2449 2450 2451 2534 2545 2559 2565 2581 2582 2583
[181] 2584 2585 2586 2589 2590 2591 2593 2595 2622 2771 2772 2794 2796 2797 2801
[196] 2802 2825 2830 2836 2850 2877 2912 2934 2935 2936 2937 2938 2939 2942 2943
[211] 2944 2945 2947 2948 2950 2951 2952 2954 3159 3160 3166 3169 3240 3244 3270
[226] 3271 3283 3300 3302 3388 3407 3430 3431 3432 3434 3435 3437 3438 3439 3440
[241] 3442 3444 3492 3531 3894 3895 3896 3897 3898 3899 3900zero_rows <- which(tl2$Blank == "0")
print(zero_rows)integer(0)one_rows <- which(tl2$Blank == "1")
print(one_rows)integer(0)rev(sort(table(tl3$Blank2))) # BM: still a lot of typos on the categories here, can you fix them?
bladelet blade flake
3042 310 244
baldelet bladele bladelete
16 6 5
? bladlet bladelt
4 3 3
falke debri chunk
2 2 2
bldelet bladrlet bladelte
2 2 2
bladelet pro blade;et vladelet
2 2 1
naturally backed flake naturally backed bladelet ladelet
1 1 1
flakemed dihedral denticulate?
1 1 1
chip? blsadelet blelt
1 1 1
bldelety blaelet bladerlet
1 1 1
bladeletmid bladelet0pro bladeler
1 1 1
bladel bladaelet badelet
1 1 1
bade
1 # BM: this is an unusual coding pattern, I'm curious about where you got it from?
tl3 <- tl3 %>%
mutate(
Blank2 = case_when(
Blank2 == "flake" ~ "flake", # Keep "flake" as it is
(`Core Typology` %in% c("0", "NA", "na", "-", ".") |
is.na(`Core Typology`) |
`Core Typology` == "") & `Width (mm)` < 12 ~ "bladelet",
(`Core Typology` %in% c("0", "NA", "na", "-", ".") |
is.na(`Core Typology`) |
`Core Typology` == "") & `Width (mm)` >= 12 ~ "blade",
TRUE ~ Blank2
)
) %>%
mutate(
Blank2 = case_when(
Blank2 %in% c("blade", "bladelet", "flake") ~ Blank2,
TRUE ~ NA_character_
)
)# Remove rows based on row names
# tl3 <- tl3[!(rownames(tl3) %in% c("1030", "644", "543")), ]
# BM: why are we removing these rows? A comment here would be good to explain. A simpler way, by referencing the row numbers directly:
# SS: they are natural rocks, and don't want to count them as lithic
tl3 <- tl3[-c(1030, 644, 543), ]tl4 <- tl3 %>%
mutate(
Utilization = if_else(Retouch == "1",
NA_character_,
as.character(Utilization))
)tl4 <- tl4 %>%
# BM: the problem with this combination of mutate_all and ifelse that you use below is that they
# coerce all columns to be the same data type, so you'll see that all the numeric
# columns are now character columns after you run these lines. So you need to
# coerce those number columns back to numeric type so you can plot and compute
# with them
mutate_all(~ ifelse(is.na(.x) | .x == "", NA, .x)) %>%
# BM: what does this next line do?
#SS: I wanted to remove any asterisks, whitespace, or *, ?, or !. is that wrong?
mutate_all(~ str_replace(., "(?<=\\D)\\*(?=\\D)|\\s+|[*?!]+", "")) %>%
# BM: what is this SHINE variable? I'm not familiar with it
##SS: we meant sickle shine, this is one of the criteria based on which Hole claimed the site is not related to agriculture (similar to ALi Kosh located in Dehluran)
mutate(
SHINE = str_trim(SHINE) %>%
str_to_title(),
shine2 = SHINE
) %>%
mutate(
shine2 = case_when(
SHINE %in% c("Subparallel",
"Parallel",
"Sub-Parallel",
"Parallel-Subprarallel",
"Scaled",
"Sub-Paralel",
"Sub-Parallell",
"Sub-Paallel",
"Sub-Paralell",
"Sub-Prallel",
"L:semiparallel/R:scaled",
"Semiparallel",
"Semi-Parallel",
"Scaled/Sub-Parallel",
"Seb-Parallel",
"Semi-Abrupt") ~ NA_character_,
TRUE ~ SHINE
),
Utilization = if_else(Utilization == "0", NA_character_, Utilization),
Retouch = if_else(Retouch == "0", NA_character_, Retouch),
SHINE = if_else(SHINE == "0", NA_character_, SHINE),
shine2 = if_else(shine2 == "0", NA_character_, shine2),
Blank2 = if_else(Blank2 == "0", NA_character_, Blank2)
) %>%
mutate(
SHINE = na_if(SHINE, "")
)
# BM: I think this is a better way to inspect:
rev(sort(table(tl4$SHINE)))
Sub-Parallel 1 Subparallel
200 56 22
Scaled Parallel Sub-Paralel
22 9 6
Semi-Parallel Sub-Prallel Semiparallel
5 4 2
Sub-Parallell Sub-Paralell Sub-Paallel
1 1 1
Semi-Abrupt Seb-Parallel Scaled/Sub-Parallel
1 1 1
Parallel-Subprarallel L:semiparallel/R: Scaled
1 1 rev(sort(table(tl4$shine2)))
1 L:semiparallel/R: Scaled
56 1 1 # Convert 'NA' and 'na' strings to actual NA
tl4$`Core Typology` <- na_if(tl4$`Core Typology`, "NA")
tl4$`Core Typology` <- na_if(tl4$`Core Typology`, "na")
tl4 <- tl4 %>%
mutate(
`Core Typology` = str_to_lower(`Core Typology`),
`Core Typology` = str_trim(`Core Typology`),
# BM: what does this regex do in the next line?
`Core Typology` = str_replace_all(`Core Typology`, "^[-._/NA\\s]*$|^\\s*$", "0")
) %>%
mutate(`Core Typology` = case_when(
`Core Typology` == "flatcore" ~ "flat-pressure",
`Core Typology` == "rejuvention" ~ "rejuvenation piece-NA",
`Core Typology` == "pressureprymidal core" ~ "pyramid-pressure",
`Core Typology` == "pressureflat core" ~ "flat-pressure",
`Core Typology` == "pressurebullet core" ~ "bullet-pressure",
`Core Typology` == "prussurebullet core" ~ "bullet-pressure",
`Core Typology` == "prismaticcore" ~ "prismatic-percussion",
`Core Typology` == "pyramidalpressure core" ~ "pyramid-pressure",
`Core Typology` == "flatcore with one debitage surface/pressure" ~ "flat-pressure",
`Core Typology` == "corefragment" ~ "core fragment-NA",
`Core Typology` == "cilandrical/pressure" ~ "cylinder-pressure",
`Core Typology` == "bullet/pressure" ~ "bullet-pressure",
`Core Typology` == "pyramidal/pressure" ~ "pyramid-pressure",
`Core Typology` == "percussion/pyramidal" ~ "pyramid-pressure",
`Core Typology` == "flat/pressure" ~ "flat-pressure",
`Core Typology` == "pyramidal/ percussion??" ~ "pyramid-pressure",
`Core Typology` == "pyramidal/ peressure" ~ "pyramid-pressure",
`Core Typology` == "pyramidal/ pressure" ~ "pyramid-pressure",
`Core Typology` == "pressure" ~ "pyramid-pressure",
`Core Typology` == "multidirectional/percussion" ~ "shapeless-percussion",
`Core Typology` == "prismatic/ percussion" ~ "pyramid-pressure",
`Core Typology` == "flatcore/ unidirectional/pressure" ~ "flat-pressure",
`Core Typology` == "heavilyused" ~ "NA",
`Core Typology` == "burnt" ~ "NA",
`Core Typology` == "patinated" ~ "NA",
`Core Typology` == "pyramidal(bullet)/pressure" ~ "bullet-pressure",
`Core Typology` == "cylandrycal/ bidirectional pressure core" ~ "bullet-pressure",
`Core Typology` == "pyramidal/unidirectional pressure bullet core" ~ "bullet-pressure",
`Core Typology` == "pyramidal/unidirectional pressure core" ~ "pyramid-pressure",
`Core Typology` == "pyramidal/unidirectional pressure core" ~ "pyramid-pressure",
`Core Typology` == "bladelet" ~ "bullet-pressure",
`Core Typology` == "lip" ~ "NA",
`Core Typology` == "bladlet" ~ "bullet-pressure",
`Core Typology` == "bladelet(30.56)" ~ "pyramid-pressure",
`Core Typology` == "bladelet(28.55.6)" ~ "bullet-pressure",
`Core Typology` == "bladelet(16.28.1)" ~ "bullet-pressure",
`Core Typology` == "bladelet(40 5.7)" ~ "pyramid-pressure",
`Core Typology` == "bladelet(23.2 2.3)" ~ "bullet-pressure",
`Core Typology` == "bladelet-flakeblade(41 16)" ~ "bullet-pressure",
`Core Typology` == "bladelet(28 6.7)" ~ "bullet-pressure",
`Core Typology` == "bladelet(28 6.7)" ~ "bullet-pressure",
`Core Typology` == "bladelet(3512.6/7)" ~ "pyramid-pressure",
`Core Typology` == "bladelet(27.307.5)" ~ "bullet-pressure",
`Core Typology` == "pressure/pyramidal" ~ "pyramid-pressure",
`Core Typology` == "bladeletcore" ~ "bullet-pressure",
`Core Typology` == "pyramidal? / pressure" ~ "pyramid-pressure",
`Core Typology` == "prismatic" ~ "pyramid-pressure",
`Core Typology` == "bullet" ~ "bullet-pressure",
TRUE ~ `Core Typology`
)) %>%
# Separate 'Core Typology' into 'core-typology' and 'core-technology'
separate(`Core Typology`,
into = c("core-typology", "core-technology"),
sep = "-",
remove = FALSE,
convert = TRUE)
# Convert 'NA' and 'na' in new columns to actual NA
tl4$`core-typology` <- na_if(tl4$`core-typology`, "na")
tl4$`core-technology` <- na_if(tl4$`core-technology`, "na")
# Check the unique values again
# BM: still many typos, are they important?
rev(sort(table((tl4$`core-typology`))))
bullet pyramid flat 0
43 39 6 5
rejuvenation piece shapeless prismatic cylinder
2 1 1 1
core fragment
1 rev(sort(table((tl4$`core-technology`))))
pressure percussion
89 2 tl4 <- tl4 %>%
mutate(
Typology = str_to_lower(Typology),
Typology = str_trim(Typology),
Typology = str_replace_all(Typology, "^[-._/NA\\s]*$|^\\s*$", "0")
) %>%
mutate(
# BM: wow, seems like almost each artefact is its own type!
# BM: That is not ideal for statistical analysis
# BM: This looks like it was very time-consuming to simplify.
##SS: this column was so messy with too many mistakes; I needed to have all typos correct then transfer them in their corresponding columns.
Typology = case_when(
`Typology` == "notch, truncated" ~ "tool/notch;truncated piece",
`Typology` == "retouchpiece" ~ "tool/retouched piece",
`Typology` == "endscraper" ~ "tool/end scraper",
`Typology` == "notch" ~ "tool/notch",
`Typology` == "sidescraper" ~ "tool/side scraper",
`Typology` == "doubleside scraper" ~ "tool/double side scraper",
`Typology` == "convergentscraper (?)" ~ "tool/convergent scraper",
`Typology` == "doublenotch on retouched piece" ~ "tool/double notch",
`Typology` == "retouchpieces" ~ "tool/retouched piece",
`Typology` == "burin(?)/ notch/scraper" ~ "tool/burin-notch-scraper",
`Typology` == "borer" ~ "tool/perforator-borer",
`Typology` == "retouchedpiece" ~ "tool/retouched piece",
`Typology` == "notch/side scraper" ~ "tool/notch-side scraper",
`Typology` == "corefragment" ~ "core/core fragment",
`Typology` == "backed" ~ "tool/backed knife",
`Typology` == "doubleside scraper ?" ~ "tool/double side scraper",
`Typology` == "inversedenticulate" ~ "tool/denticulate",
`Typology` == "retouchpieces/ side scraper?" ~ "tool/side scraper",
`Typology` == "sidescraper ?" ~ "tool/side scraper",
`Typology` == "notch-denticulate" ~ "tool/notch-denticulate",
`Typology` == "borer/drill" ~ "tool/perforator-drill",
`Typology` == "retouchedpiece (side scraper?)" ~ "tool/side scraper",
`Typology` == "retouchepiece (side scraper?)" ~ "tool/side scraper",
`Typology` == "retouchedpiece (double side scraper)" ~ "tool/double side scraper",
`Typology` == "retouchedpiece (double side scraper?)" ~ "tool/double side scraper",
`Typology` == "retouchepiece" ~ "tool/retouched piece",
`Typology` == "inversenotch" ~ "tool/notch",
`Typology` == "retouchepiece (double side scaraper?)" ~ "tool/double side scraper",
`Typology` == "retouchedpiece( double side scraper?)" ~ "tool/double side scraper",
`Typology` == "notchon retouche piece" ~ "tool/notch",
`Typology` == "retouchedpiece (souble side scraper)" ~ "tool/double side scraper",
`Typology` == "point" ~ "tool/perforator-point",
`Typology` == "chunk" ~ "NA/NA",
`Typology` == "coretablet" ~ "core/core tablet",
`Typology` == "core" ~ "core/shapeless",
`Typology` == "denticulate" ~ "tool/denticulate",
`Typology` == "doublenotch (haft)" ~ "tool/double notch",
`Typology` == "retouchedpiece (fine retouch)" ~ "tool/retouched piece",
`Typology` == "endscraper on retouched piece" ~ "tool/end scraper",
`Typology` == "retouchedpiece (serrated scraper)" ~ "tool/serrated scraper",
`Typology` == "truncation" ~ "tool/truncated piece",
`Typology` == "rejuventionpiece" ~ "core/rejuvenation piece",
`Typology` == "notch/denticulate" ~ "tool/notch-denticulate",
`Typology` == "retoucheduse on breakage" ~ "tool/retouched piece",
`Typology` == "inversenotch/endscraper" ~ "tool/notch-end scraper",
`Typology` == "alternatingside scraper" ~ "tool/side scraper",
`Typology` == "alternatedouble side scraper" ~ "tool/double side scraper",
`Typology` == "truncation/sidescaraper" ~ "tool/truncated piece",
`Typology` == "doublenotch" ~ "tool/double notch",
`Typology` == "borer/awl" ~ "tool/perforator-awl",
`Typology` == "roundscraper?" ~ "tool/round scraper",
`Typology` == "doublenotch scraper" ~ "tool/double notch scraper",
`Typology` == "corerejuvention (core tablet?)" ~ "core/core tablet",
`Typology` == "truncationاریبب" ~ "tool/truncated piece",
`Typology` == "retouchedpiece (side scraper)" ~ "tool/side scraper",
`Typology` == "retochedpice" ~ "tool/retouched piece",
`Typology` == "truncation/notch" ~ "tool/truncated piece-notch",
`Typology` == "doublealternate scraper" ~ "tool/double side scraper",
`Typology` == "awl/ inverse notch" ~ "tool/notch",
`Typology` == "retouchedpiece (alternate scraper?)" ~ "tool/double side scraper",
`Typology` == "inverseside scraper" ~ "tool/side scraper",
`Typology` == "usedcore rejuvention" ~ "core/rejuvenation piece",
`Typology` == "coreside rejuvention" ~ "core/rejuvenation piece",
`Typology` == "coreplatform rejuvention flake" ~ "core/rejuvenation piece",
`Typology` == "corerejuvention platform" ~ "core/rejuvenation piece",
`Typology` == "coreside rejuvention blade" ~ "core/rejuvenation piece",
`Typology` == "coreside rejuvention blade??" ~ "core/rejuvenation piece",
`Typology` == "coreedge rejuvention" ~ "core/rejuvenation piece",
`Typology` == "coreedge rejivention" ~ "core/rejuvenation piece",
`Typology` == "retouchedpice (side scraper?)" ~ "tool/side scraper" ,
`Typology` == "scraper" ~ "tool/side scraper",
`Typology` == "sickleblade" ~ "tool/sickle shine",
`Typology` == "coretool (scraper)" ~ "tool/scraper-on core piece",
`Typology` == "retouchedpiece (scraper)" ~ "tool/side scraper",
`Typology` == "inversedenticulate?" ~ "tool/denticulate",
`Typology` == "retouchedpiece (scraper?)" ~ "tool/side scraper",
`Typology` == "coreside rejuvention flake" ~ "core/rejuvenation piece",
`Typology` == "truncation/endscraper" ~ "tool/endscraper on truncated piece",
`Typology` == "retouchedpice(double side scraper?)" ~ "tool/double side scraper",
`Typology` == "doublescraper" ~ "tool/double side scraper",
`Typology` == "dendiculate" ~ "tool/denticulate",
`Typology` == "double-scraper" ~ "tool/double side scraper",
`Typology` == "pyramidalcore" ~ "core/pyramid",
`Typology` == "bulletcore" ~ "core/bullet",
`Typology` == "corerejuvention" ~ "core/rejuvenation piece",
`Typology` == "pyrmidalcore" ~ "core/pyramid",
`Typology` == "corepreperation" ~ "core/core preparation piece",
`Typology` == "crested" ~ "core/crested bladelet",
`Typology` == "preperationblade" ~ "core/core preperation",
`Typology` == "burin" ~ "tool/burin",
`Typology` == "serrateddenticulate" ~ "tool/serrated scraper",
`Typology` == "saw:serrated denticulate" ~ "tool/serrated scraper",
`Typology` == "serratedused" ~ "tool/serrated scraper",
`Typology` == "corepreeration" ~ "tool/core preparation piece",
`Typology` == "coreprepearation" ~ "tool/core preparation piece",
`Typology` == "awl" ~ "tool/perforator-awl",
`Typology` == "notch.inverse" ~ "tool/notch",
`Typology` == "point.notch" ~ "tool/perforator-point;notch",
`Typology` == "inversescraper" ~ "tool/side scraper",
`Typology` == "roundendscraper" ~ "tool/round scraper",
`Typology` == "alternate.scraper" ~ "tool/double side scraper",
`Typology` == "convergentscraper/disc scraper" ~ "tool/scraper-convergent scraper",
`Typology` == "serratedside scraper" ~ "tool/serrated scraper",
`Typology` == "debri" ~ "NA/NA",
`Typology` == "distalpart of a drill" ~ "tool/perforator-drill",
`Typology` == "corepreperation?" ~ "core/core preparation piece",
`Typology` == "preformend of a borer" ~ "tool/perforator-borer; preform",
`Typology` == "used" ~ "tool/used",
`Typology` == "distalend of a inverse sidescraper" ~ "tool/side scraper",
`Typology` == "retouchedblade" ~ "tool/retouched piece",
`Typology` == "drill" ~ "tool/perforator-drill",
`Typology` == "corerejuvention tablet" ~ "core/core tablet",
`Typology` == "bladeletcore" ~ "core/pyramid",
`Typology` == "flake-bladecore" ~ "core/mixed",
`Typology` == "notch, truncated" ~ "tool/notch;truncated piece",
`Typology` == "retouchpiece" ~ "tool/retouched piece",
`Typology` == "endscraper" ~ "tool/end scraper",
`Typology` == "notch" ~ "tool/notch",
`Typology` == "sidescraper" ~ "tool/side scraper",
`Typology` == "doubleside scraper" ~ "tool/double side scraper",
`Typology` == "convergentscraper (?)" ~ "tool/convergent scraper",
`Typology` == "doublenotch on retouched piece" ~ "tool/double notch",
`Typology` == "retouchpieces" ~ "tool/retouched piece",
`Typology` == "burin(?)/ notch/scraper" ~ "tool/burin-notch-scraper",
`Typology` == "borer" ~ "tool/perforator-borer",
`Typology` == "retouchedpiece" ~ "tool/retouched piece",
`Typology` == "notch/side scraper" ~ "tool/notch-side scraper",
`Typology` == "corefragment" ~ "core/core fragment",
`Typology` == "backed" ~ "tool/backed knife",
`Typology` == "doubleside scraper ?" ~ "tool/double side scraper",
`Typology` == "inversedenticulate" ~ "tool/denticulate",
`Typology` == "retouchpieces/ side scraper?" ~ "tool/side scraper",
`Typology` == "sidescraper ?" ~ "tool/side scraper",
`Typology` == "notch-denticulate" ~ "tool/notch-denticulate",
`Typology` == "borer/drill" ~ "tool/perforator-drill",
`Typology` == "retouchedpiece (side scraper?)" ~ "tool/side scraper",
`Typology` == "retouchepiece (side scraper?)" ~ "tool/side scraper",
`Typology` == "retouchedpiece (double side scraper)" ~ "tool/double side scraper",
`Typology` == "retouchedpiece (double side scraper?)" ~ "tool/double side scraper",
`Typology` == "retouchepiece" ~ "tool/retouched piece",
`Typology` == "inversenotch" ~ "tool/notch",
`Typology` == "retouchepiece (double side scaraper?)" ~ "tool/double side scraper",
`Typology` == "retouchedpiece( double side scraper?)" ~ "tool/double side scraper",
`Typology` == "notchon retouche piece" ~ "tool/notch",
`Typology` == "retouchedpiece (souble side scraper)" ~ "tool/double side scraper",
`Typology` == "point" ~ "tool/perforator-point",
`Typology` == "chunk" ~ "NA/NA",
`Typology` == "coretablet" ~ "core/core tablet",
`Typology` == "core" ~ "core/shapeless",
`Typology` == "denticulate" ~ "tool/denticulate",
`Typology` == "doublenotch (haft)" ~ "tool/double notch",
`Typology` == "retouchedpiece (fine retouch)" ~ "tool/retouched piece",
`Typology` == "endscraper on retouched piece" ~ "tool/end scraper",
`Typology` == "retouchedpiece (serrated scraper)" ~ "tool/serrated scraper",
`Typology` == "truncation" ~ "tool/truncated piece",
`Typology` == "rejuventionpiece" ~ "core/rejuvenation piece",
`Typology` == "notch/denticulate" ~ "tool/notch-denticulate",
`Typology` == "retoucheduse on breakage" ~ "tool/retouched piece",
`Typology` == "inversenotch/endscraper" ~ "tool/notch-end scraper",
`Typology` == "alternatingside scraper" ~ "tool/side scraper",
`Typology` == "alternatedouble side scraper" ~ "tool/double side scraper",
`Typology` == "truncation/sidescaraper" ~ "tool/truncated piece",
`Typology` == "doublenotch" ~ "tool/double notch",
`Typology` == "borer/awl" ~ "tool/perforator-awl",
`Typology` == "roundscraper?" ~ "tool/round scraper",
`Typology` == "doublenotch scraper" ~ "tool/double notch scraper",
`Typology` == "corerejuvention (core tablet?)" ~ "core/core tablet",
`Typology` == "truncationاریبب" ~ "tool/truncated piece",
`Typology` == "retouchedpiece (side scraper)" ~ "tool/side scraper",
`Typology` == "retochedpice" ~ "tool/retouched piece",
`Typology` == "truncation/notch" ~ "tool/truncated piece-notch",
`Typology` == "doublealternate scraper" ~ "tool/double side scraper",
`Typology` == "awl/ inverse notch" ~ "tool/notch",
`Typology` == "retouchedpiece (alternate scraper?)" ~ "tool/double side scraper",
`Typology` == "inverseside scraper" ~ "tool/side scraper",
`Typology` == "usedcore rejuvention" ~ "core/rejuvenation piece",
`Typology` == "coreside rejuvention" ~ "core/rejuvenation piece",
`Typology` == "coreplatform rejuvention flake" ~ "core/rejuvenation piece",
`Typology` == "corerejuvention platform" ~ "core/rejuvenation piece",
`Typology` == "coreside rejuvention blade" ~ "core/rejuvenation piece",
`Typology` == "coreside rejuvention blade??" ~ "core/rejuvenation piece",
`Typology` == "coreedge rejuvention" ~ "core/rejuvenation piece",
`Typology` == "coreedge rejivention" ~ "core/rejuvenation piece",
`Typology` == "retouchedpice (side scraper?)" ~ "tool/side scraper" ,
`Typology` == "scraper" ~ "tool/side scraper",
`Typology` == "sickleblade" ~ "tool/sickle shine",
`Typology` == "coretool (scraper)" ~ "tool/scraper-on core piece",
`Typology` == "retouchedpiece (scraper)" ~ "tool/side scraper",
`Typology` == "inversedenticulate?" ~ "tool/denticulate",
`Typology` == "retouchedpiece (scraper?)" ~ "tool/side scraper",
`Typology` == "coreside rejuvention flake" ~ "core/rejuvenation piece",
`Typology` == "truncation/endscraper" ~ "tool/endscraper on truncated piece",
`Typology` == "retouchedpice(double side scraper?)" ~ "tool/double side scraper",
`Typology` == "doublescraper" ~ "tool/double side scraper",
`Typology` == "dendiculate" ~ "tool/denticulate",
`Typology` == "double-scraper" ~ "tool/double side scraper",
`Typology` == "pyramidalcore" ~ "core/pyramid",
`Typology` == "bulletcore" ~ "core/bullet",
`Typology` == "corerejuvention" ~ "core/rejuvenation piece",
`Typology` == "pyrmidalcore" ~ "core/pyramid",
`Typology` == "corepreperation" ~ "core/core preparation piece",
`Typology` == "crested" ~ "core/crested bladelet",
`Typology` == "preperationblade" ~ "core/core preperation",
`Typology` == "burin" ~ "tool/burin",
`Typology` == "serrateddenticulate" ~ "tool/serrated scraper",
`Typology` == "saw:serrated denticulate" ~ "tool/serrated scraper",
`Typology` == "serratedused" ~ "tool/serrated scraper",
`Typology` == "corepreeration" ~ "tool/core preparation piece",
`Typology` == "coreprepearation" ~ "tool/core preparation piece",
`Typology` == "awl" ~ "tool/perforator-awl",
`Typology` == "notch.inverse" ~ "tool/notch",
`Typology` == "point.notch" ~ "tool/perforator-point;notch",
`Typology` == "inversescraper" ~ "tool/side scraper",
`Typology` == "roundendscraper" ~ "tool/round scraper",
`Typology` == "alternate.scraper" ~ "tool/double side scraper",
`Typology` == "convergentscraper/disc scraper" ~ "tool/scraper-convergent scraper",
`Typology` == "serratedside scraper" ~ "tool/serrated scraper",
`Typology` == "debri" ~ "NA/NA",
`Typology` == "distalpart of a drill" ~ "tool/perforator-drill",
`Typology` == "corepreperation?" ~ "core/core preparation piece",
`Typology` == "preformend of a borer" ~ "tool/perforator-borer; preform",
`Typology` == "used" ~ "tool/used",
`Typology` == "distalend of a inverse sidescraper" ~ "tool/side scraper",
`Typology` == "retouchedblade" ~ "tool/retouched piece",
`Typology` == "drill" ~ "tool/perforator-drill",
`Typology` == "corerejuvention tablet" ~ "core/core tablet",
`Typology` == "bladeletcore" ~ "core/pyramid",
`Typology` == "flake-bladecore" ~ "core/mixed",
`Typology` == "bladelet-corerejuvention" ~ "core/rejuvenation piece",
`Typology` == "bladelet-corefragment" ~ "core/core fragment",
`Typology` == "pointedused" ~ "tool/perforator-point",
`Typology` == "microburin" ~ "tool/microburin",
`Typology` == "bladeletcore fragment" ~ "core/core fragment",
`Typology` == "rejuventionface flake" ~ "core/rejuvenation piece",
`Typology` == "corepreperation flake" ~ "core/core preparation piece",
`Typology` == "corerejuvention flake" ~ "core/rejuvenation piece",
`Typology` == "unfinished pyramid core" ~ "core/pyramid",
`Typology` == "bladeletcoretablet" ~ "core/core tablet",
`Typology` == "bladeletcore rejuvention" ~ "core/rejuvenation piece",
`Typology` == "debitage" ~ "NA/NA",
`Typology` == "bladeletcore rejuvention" ~ "core/rejuvenation piece",
`Typology` == "inverseserrated scraper" ~ "tool/serrated scraper",
`Typology` == "backedknife" ~ "tool/backed knife",
`Typology` == "corepreparation" ~ "core/core preparation piece",
`Typology` == "primaryflake" ~ "core/primary flake",
`Typology` == "pointedconvergent scraper on bladelet" ~ "tool/perforator-point",
`Typology` == "trie" ~ "NA/NA",
`Typology` == "part of core tablet" ~ "core/core tablet",
`Typology` == "zaviedar" ~ "NA/NA",
`Typology` == "convergentscraper" ~ "tool/convergent scraper",
`Typology` == "preparationflake" ~ "core/core preparation piece",
`Typology` == "atypicalborer" ~ "tool/perforator-borer",
`Typology` == "naturalybacked knife" ~ "tool/backed knife-naturally backed knife",
`Typology` == "pyramidbladelet core" ~ "core/pyramid",
`Typology` == "flatbladelet core" ~ "core/flat",
`Typology` == "bladecore" ~ "core/pyramid",
`Typology` == "bulletbladelet core" ~ "core/bullet",
`Typology` == "coerejuvention flake" ~ "core/rejuvenation piece",
`Typology` == "finishedbladelet core" ~ "core/bullet",
`Typology` == "failed pyramid core?" ~ "core/pyramid",
`Typology` == "pyramidplain bladelet core" ~ "core/pyramid",
`Typology` == "coeon flake" ~ "core/core on flake",
`Typology` == "coeejuvention flake" ~ "core/rejuvenation piece",
`Typology` == "bladeletcoe rejuvention tablet?" ~ "core/core tablet",
`Typology` == "pyramidcore" ~ "core/pyramid",
`Typology` == "bladeletcore tablet" ~ "core/core tablet",
`Typology` == "pyramidbladeleet core" ~ "core/pyramid",
`Typology` == "flake" ~ "NA/NA",
`Typology` == "serrated" ~ "tool/serrated scraper",
`Typology` == "curvedretouched piece" ~ "tool/retouched piece",
`Typology` == "pyramidalbladelet core" ~ "core/pyramid",
`Typology` == "multidirectionalcore fragment" ~ "core/multidirectional core fragment",
`Typology` == "unidirectionalblade? core fragent" ~ "core/pyramid",
`Typology` == "backed/corerejuvention" ~ "tool/backed knife",
`Typology` == "unidirectionalbladelet core" ~ "core/pyramid",
`Typology` == "unifacialbalde core fragment?" ~ "core/pyramid",
`Typology` == "flakedetached from a bladelet core" ~ "core/core preparation piece",
`Typology` == "corepreparation tablet" ~ "core/core tablet",
`Typology` == "bladeletcore fragent" ~ "core/core fragment-pyramid",
`Typology` == "alternatescraper??" ~ "tool/double side scraper",
`Typology` == "endscraper.onrejuvention" ~ "core/rejuvenation piece",
`Typology` == "inverseserrated" ~ "tool/serrated scraper",
`Typology` == "patination.omitted" ~ "NA/NA",
`Typology` == "trapze" ~ "tool/geometric-triangle",
`Typology` == "trapzoid" ~ "tool/geometric-triangle",
`Typology` == "borer.drill" ~ "tool/perforator-drill",
`Typology` == "serraed" ~ "tool/serrated scraper",
`Typology` == "bladeletcore on a flake" ~ "core/core on flake",
`Typology` == "geofact" ~ "NA/NA",
`Typology` == "denticulateborer?" ~ "tool/perforator-borer;denticulate",
`Typology` == "sideborer-denticulate" ~ "tool/perforator-borer;denticulate",
`Typology` == "borer.awl" ~ "tool/perforator-awl",
`Typology` == "roundscraper" ~ "tool/round scraper",
`Typology` == "truncationon a bladelet core" ~ "tool/truncated piece",
`Typology` == "truncation.notch" ~ "tool/truncated piece;notch",
`Typology` == "backed-denticulate" ~ "tool/backed;denticulate",
`Typology` == "brokendrill" ~ "tool/perforator-drill",
`Typology` == "drillbroken" ~ "tool/perforator-drill",
`Typology` == "point/broken drill" ~ "tool/perforator-point",
`Typology` == "brokendrill?" ~ "tool/perforator-drill",
`Typology` == "partialyserrated" ~ "tool/serrated scraper",
`Typology` == "naturallybacked" ~ "tool/backed knife-naturally backed knife",
`Typology` == "transversescraper" ~ "tool/transverse scraper",
`Typology` == "naturalybacked" ~ "tool/backed knife-naturally backed knife",
`Typology` == "awl-notch" ~ "tool/perforator-awl",
`Typology` == "psedulevalois" ~ "tool/psedulevalois flake",
`Typology` == "alternatingdenticulate" ~ "tool/denticulate",
`Typology` == "usedcore fragment" ~ "tool/core tool-used core fragment",
`Typology` == "multidirectionalmicroflake core" ~ "core/multidirectional flake core",
`Typology` == "mixedpyramidal core" ~ "core/pyramid",
`Typology` == "usedbladecore fragment" ~ "tool/core tool-used core fragment",
`Typology` == "multidirectionalbladelet core fragment" ~ "core/multidirectional bladelet core",
`Typology` == "unidirectionalbladelet core.cylinder" ~ "core/prismatic",
`Typology` == "pyrymedalmixed core" ~ "core/pyramid",
`Typology` == "pyramedial/bullet core" ~ "core/bullet",
`Typology` == "corefragent" ~ "core/core fragment",
`Typology` == "pyramedialbladelet core fragment" ~ "core/pyramid",
`Typology` == "unidirectionalbladelet core fragment" ~ "core/pyramid",
`Typology` == "unifacialunidirectional bladelet core" ~ "core/pyramid",
`Typology` == "unidirectionalblade core" ~ "core/pyramid",
`Typology` == "pyramidalbladelet core fragment" ~ "core/pyramid",
`Typology` == "corerejuvention?" ~ "core/rejuvenation piece",
`Typology` == "flatburin? point?" ~ "tool/flat burin",
`Typology` == "primaryblade" ~ "core/primary blade",
`Typology` == "trihedralgeometric" ~ "tool/geometric-triangle",
`Typology` == "lunate" ~ "tool/geometric-lunate",
`Typology` == "corepaltform rejuvention flake" ~ "core/rejuvenation piece",
`Typology` == "pressurebladelet core /semi flat" ~ "core/pyramid",
`Typology` == "failedpercussion blade core/semi pyramedal" ~ "core/pyramid",
`Typology` == "percussionbladelet core/unidirectional" ~ "core/pyramid-percussion",
`Typology` == "percussion.unidirectional.blade-flakecore" ~ "core/mixed-percussion",
`Typology` == "obliqueretouched bladelet" ~ "tool/retouched piece",
`Typology` == "percussionunidirectional pyramidal bladelet core" ~ "core/pyramid",
`Typology` == "lunategeometric" ~ "tool/geometric-lunate",
`Typology` == "awl on a core rejuvention" ~ "tool/perforator-awl on core rejuvenation piece",
`Typology` == "truncated" ~ "tool/truncated piece",
`Typology` == "multiplenotch" ~ "tool/notch",
`Typology` == "dishedconvergent bladelet" ~ "tool/convergent scraper",
`Typology` == "bipolarpercussion blade-bladelet core" ~ "core/bipolar-percussion",
`Typology` == "bladeletbullet core" ~ "core/bullet",
`Typology` == "alternatingserrated" ~ "tool/serrated scraper",
`Typology` == "shaplesscore" ~ "core/shapeless",
`Typology` == "corepreparation?" ~ "core/core preparation piece",
`Typology` == "obliqueretouched" ~ "tool/retouched piece",
`Typology` == "corepreparation flake" ~ "core/core preparation piece",
`Typology` == "backeddenticulate" ~ "tool/backed;denticulate",
`Typology` == "awlnotch" ~ "tool/perforator-awl;notch",
`Typology` == "scraperburin?" ~ "tool/burin;scraper",
`Typology` == "notchround scraper" ~ "tool/round scraper;notch",
`Typology` == "corerejuvention tablet round scraper" ~ "tool/round scraper on core tablet",
`Typology` == "alternatescraper" ~ "tool/double side scraper",
`Typology` == "coreplatform preperation flake" ~ "core/rejuvenation piece",
`Typology` == "coreplatform rejuvention tablet" ~ "core/core tablet",
`Typology` == "brokenpyramidal core bladelet" ~ "core/pyramid",
`Typology` == "pyramidalbladelet core/semi bullet?" ~ "core/bullet",
`Typology` == "coreside rejuvention flake?" ~ "core/rejuvenation piece-side",
`Typology` == "unidirectionalpressure bladelet core/unifacila" ~ "core/pyramid",
`Typology` == "coreplatform rejuvention tablet/or multidirectional core" ~ "core/rejuvenation piece",
`Typology` == "bulletbladlet core" ~ "core/bullet",
`Typology` == "cylinderbipolar bladelet core" ~ "core/prismatic",
`Typology` == "backedknife/core platform rejuvenation" ~ "tool/backed knife",
`Typology` == "flatunifacial bladelet core" ~ "core/flat",
`Typology` == "coreprepration flake" ~ "core/core preparation piece",
`Typology` == "coreplatform preperation" ~ "core/core preparation piece-platform",
`Typology` == "borerpreform" ~ "tool/perforator-borer",
`Typology` == "rejuvention" ~ "core/rejuvenation piece",
`Typology` == "borerpreform?" ~ "tool/perforator-borer",
`Typology` == "inversnotch" ~ "tool/notch",
`Typology` == "alternateconvergent" ~ "tool/convergent scraper",
`Typology` == "unidirectionalbladelet/flake-blade core" ~ "core/mixed",
`Typology` == "unidirectionalmixed core" ~ "core/mixed",
`Typology` == "unidirectionalflat bladelet core" ~ "core/flat",
`Typology` == "" ~ "NA-NA",
`Typology` == "na" ~ "NA-NA",
`Typology` == "bladelet-corerejuvention" ~ "core/rejuvenation piece",
`Typology` == "bladelet-corefragment" ~ "core/core fragment",
`Typology` == "pointedused" ~ "tool/perforator-point",
`Typology` == "microburin" ~ "tool/microburin",
`Typology` == "bladeletcore fragment" ~ "core/core fragment",
`Typology` == "rejuventionface flake" ~ "core/rejuvenation piece",
`Typology` == "corepreperation flake" ~ "core/core preparation piece",
`Typology` == "corerejuvention flake" ~ "core/rejuvenation piece",
`Typology` == "unfinished pyramid core" ~ "core/pyramid",
`Typology` == "bladeletcoretablet" ~ "core/core tablet",
`Typology` == "bladeletcore rejuvention" ~ "core/rejuvenation piece",
`Typology` == "debitage" ~ "NA/NA",
`Typology` == "bladeletcore rejuvention" ~ "core/rejuvenation piece",
`Typology` == "inverseserrated scraper" ~ "tool/serrated scraper",
`Typology` == "backedknife" ~ "tool/backed knife",
`Typology` == "corepreparation" ~ "core/core preparation piece",
`Typology` == "primaryflake" ~ "core/primary flake",
`Typology` == "pointedconvergent scraper on bladelet" ~ "tool/perforator-point",
`Typology` == "trie" ~ "NA/NA",
`Typology` == "part of core tablet" ~ "core/core tablet",
`Typology` == "zaviedar" ~ "NA/NA",
`Typology` == "convergentscraper" ~ "tool/convergent scraper",
`Typology` == "preparationflake" ~ "core/core preparation piece",
`Typology` == "atypicalborer" ~ "tool/perforator-borer",
`Typology` == "naturalybacked knife" ~ "tool/backed knife-naturally backed knife",
`Typology` == "pyramidbladelet core" ~ "core/pyramid",
`Typology` == "flatbladelet core" ~ "core/flat",
`Typology` == "bladecore" ~ "core/pyramid",
`Typology` == "bulletbladelet core" ~ "core/bullet",
`Typology` == "coerejuvention flake" ~ "core/rejuvenation piece",
`Typology` == "finishedbladelet core" ~ "core/bullet",
`Typology` == "failed pyramid core?" ~ "core/pyramid",
`Typology` == "pyramidplain bladelet core" ~ "core/pyramid",
`Typology` == "coeon flake" ~ "core/core on flake",
`Typology` == "coeejuvention flake" ~ "core/rejuvenation piece",
`Typology` == "bladeletcoe rejuvention tablet?" ~ "core/core tablet",
`Typology` == "pyramidcore" ~ "core/pyramid",
`Typology` == "bladeletcore tablet" ~ "core/core tablet",
`Typology` == "pyramidbladeleet core" ~ "core/pyramid",
`Typology` == "flake" ~ "NA/NA",
`Typology` == "serrated" ~ "tool/serrated scraper",
`Typology` == "curvedretouched piece" ~ "tool/retouched piece",
`Typology` == "pyramidalbladelet core" ~ "core/pyramid",
`Typology` == "multidirectionalcore fragment" ~ "core/multidirectional core fragment",
`Typology` == "unidirectionalblade? core fragent" ~ "core/pyramid",
`Typology` == "backed/corerejuvention" ~ "tool/backed knife",
`Typology` == "unidirectionalbladelet core" ~ "core/pyramid",
`Typology` == "unifacialbalde core fragment?" ~ "core/pyramid",
`Typology` == "flakedetached from a bladelet core" ~ "core/core preparation piece",
`Typology` == "corepreparation tablet" ~ "core/core tablet",
`Typology` == "bladeletcore fragent" ~ "core/core fragment-pyramid",
`Typology` == "alternatescraper??" ~ "tool/double side scraper",
`Typology` == "endscraper.onrejuvention" ~ "core/rejuvenation piece",
`Typology` == "inverseserrated" ~ "tool/serrated scraper",
`Typology` == "patination.omitted" ~ "NA/NA",
`Typology` == "trapze" ~ "tool/geometric-triangle",
`Typology` == "trapzoid" ~ "tool/geometric-triangle",
`Typology` == "borer.drill" ~ "tool/perforator-drill",
`Typology` == "serraed" ~ "tool/serrated scraper",
`Typology` == "bladeletcore on a flake" ~ "core/core on flake",
`Typology` == "geofact" ~ "NA/NA",
`Typology` == "denticulateborer?" ~ "tool/perforator-borer;denticulate",
`Typology` == "sideborer-denticulate" ~ "tool/perforator-borer;denticulate",
`Typology` == "borer.awl" ~ "tool/perforator-awl",
`Typology` == "roundscraper" ~ "tool/round scraper",
`Typology` == "truncationon a bladelet core" ~ "tool/truncated piece",
`Typology` == "truncation.notch" ~ "tool/truncated piece;notch",
`Typology` == "backed-denticulate" ~ "tool/backed;denticulate",
`Typology` == "brokendrill" ~ "tool/perforator-drill",
`Typology` == "drillbroken" ~ "tool/perforator-drill",
`Typology` == "point/broken drill" ~ "tool/perforator-point",
`Typology` == "brokendrill?" ~ "tool/perforator-drill",
`Typology` == "partialyserrated" ~ "tool/serrated scraper",
`Typology` == "naturallybacked" ~ "tool/backed knife-naturally backed knife",
`Typology` == "transversescraper" ~ "tool/transverse scraper",
`Typology` == "naturalybacked" ~ "tool/backed knife-naturally backed knife",
`Typology` == "awl-notch" ~ "tool/perforator-awl",
`Typology` == "psedulevalois" ~ "tool/psedulevalois flake",
`Typology` == "alternatingdenticulate" ~ "tool/denticulate",
`Typology` == "usedcore fragment" ~ "tool/core tool-used core fragment",
`Typology` == "multidirectionalmicroflake core" ~ "core/multidirectional flake core",
`Typology` == "mixedpyramidal core" ~ "core/pyramid",
`Typology` == "usedbladecore fragment" ~ "tool/core tool-used core fragment",
`Typology` == "multidirectionalbladelet core fragment" ~ "core/multidirectional bladelet core",
`Typology` == "unidirectionalbladelet core.cylinder" ~ "core/prismatic",
`Typology` == "pyrymedalmixed core" ~ "core/pyramid",
`Typology` == "pyramedial/bullet core" ~ "core/bullet",
`Typology` == "corefragent" ~ "core/core fragment",
`Typology` == "pyramedialbladelet core fragment" ~ "core/pyramid",
`Typology` == "unidirectionalbladelet core fragment" ~ "core/pyramid",
`Typology` == "unifacialunidirectional bladelet core" ~ "core/pyramid",
`Typology` == "unidirectionalblade core" ~ "core/pyramid",
`Typology` == "pyramidalbladelet core fragment" ~ "core/pyramid",
`Typology` == "corerejuvention?" ~ "core/rejuvenation piece",
`Typology` == "flatburin? point?" ~ "tool/flat burin",
`Typology` == "primaryblade" ~ "core/primary blade",
`Typology` == "trihedralgeometric" ~ "tool/geometric-triangle",
`Typology` == "lunate" ~ "tool/geometric-lunate",
`Typology` == "corepaltform rejuvention flake" ~ "core/rejuvenation piece",
`Typology` == "pressurebladelet core /semi flat" ~ "core/pyramid",
`Typology` == "failedpercussion blade core/semi pyramedal" ~ "core/pyramid",
`Typology` == "percussionbladelet core/unidirectional" ~ "core/pyramid-percussion",
`Typology` == "percussion.unidirectional.blade-flakecore" ~ "core/mixed-percussion",
`Typology` == "obliqueretouched bladelet" ~ "tool/retouched piece",
`Typology` == "percussionunidirectional pyramidal bladelet core" ~ "core/pyramid",
`Typology` == "lunategeometric" ~ "tool/geometric-lunate",
`Typology` == "awl on a core rejuvention" ~ "tool/perforator-awl on core rejuvenation piece",
`Typology` == "truncated" ~ "tool/truncated piece",
`Typology` == "multiplenotch" ~ "tool/notch",
`Typology` == "dishedconvergent bladelet" ~ "tool/convergent scraper",
`Typology` == "bipolarpercussion blade-bladelet core" ~ "core/bipolar-percussion",
`Typology` == "bladeletbullet core" ~ "core/bullet",
`Typology` == "alternatingserrated" ~ "tool/serrated scraper",
`Typology` == "shaplesscore" ~ "core/shapeless",
`Typology` == "corepreparation?" ~ "core/core preparation piece",
`Typology` == "obliqueretouched" ~ "tool/retouched piece",
`Typology` == "corepreparation flake" ~ "core/core preparation piece",
`Typology` == "backeddenticulate" ~ "tool/backed;denticulate",
`Typology` == "awlnotch" ~ "tool/perforator-awl;notch",
`Typology` == "scraperburin?" ~ "tool/burin;scraper",
`Typology` == "notchround scraper" ~ "tool/round scraper;notch",
`Typology` == "corerejuvention tablet round scraper" ~ "tool/round scraper on core tablet",
`Typology` == "alternatescraper" ~ "tool/double side scraper",
`Typology` == "coreplatform preperation flake" ~ "core/rejuvenation piece",
`Typology` == "coreplatform rejuvention tablet" ~ "core/core tablet",
`Typology` == "brokenpyramidal core bladelet" ~ "core/pyramid",
`Typology` == "pyramidalbladelet core/semi bullet?" ~ "core/bullet",
`Typology` == "coreside rejuvention flake?" ~ "core/rejuvenation piece-side",
`Typology` == "unidirectionalpressure bladelet core/unifacila" ~ "core/pyramid",
`Typology` == "coreplatform rejuvention tablet/or multidirectional core" ~ "core/rejuvenation piece",
`Typology` == "bulletbladlet core" ~ "core/bullet",
`Typology` == "cylinderbipolar bladelet core" ~ "core/prismatic",
`Typology` == "backedknife/core platform rejuvenation" ~ "tool/backed knife",
`Typology` == "flatunifacial bladelet core" ~ "core/flat",
`Typology` == "coreprepration flake" ~ "core/core preparation piece",
`Typology` == "coreplatform preperation" ~ "core/core preparation piece-platform",
`Typology` == "borerpreform" ~ "tool/perforator-borer",
`Typology` == "rejuvention" ~ "core/rejuvenation piece",
`Typology` == "borerpreform?" ~ "tool/perforator-borer",
`Typology` == "inversnotch" ~ "tool/notch",
`Typology` == "alternateconvergent" ~ "tool/convergent scraper",
`Typology` == "unidirectionalbladelet/flake-blade core" ~ "core/mixed",
`Typology` == "unidirectionalmixed core" ~ "core/mixed",
`Typology` == "unidirectionalflat bladelet core" ~ "core/flat",
`Typology` == "" ~ "NA-NA",
`Typology` == "na" ~ "NA-NA",
TRUE ~ `Typology`
)
) %>%
mutate(
typology_split = str_split(Typology, "/", simplify = TRUE),
`typology-tool-core` = typology_split[, 1],
tool_or_core = ifelse(str_starts(`typology-tool-core`, "tool"), "tool", "core"),
`tool-typology` = ifelse(tool_or_core == "tool", typology_split[, 2], NA),
`core-fragment` = ifelse(tool_or_core == "core", typology_split[, 2], NA)
) %>%
# remove temporary columns
select(-typology_split,-tool_or_core)
# BM: still some typos in there
rev(sort(table((tl4$`tool-typology`))))
notch
84
retouched piece
58
double side scraper
44
side scraper
41
denticulate
38
perforator-drill
19
serrated scraper
18
perforator-borer
18
end scraper
12
truncated piece
10
backed knife
10
perforator-awl
8
burin
8
double notch
7
perforator-point
6
convergent scraper
5
microburin
4
backed knife-naturally backed knife
4
used
3
round scraper
3
notch-denticulate
3
geometric-triangle
3
perforator-borer;denticulate
2
geometric-lunate
2
core tool-used core fragment
2
core preparation piece
2
backed;denticulate
2
truncated piece;notch
1
truncated piece-notch
1
transverse scraper
1
sickle shine
1
scraper-on core piece
1
scraper-convergent scraper
1
round scraper;notch
1
round scraper on core tablet
1
psedulevalois flake
1
perforator-point;notch
1
perforator-borer; preform
1
perforator-awl;notch
1
perforator-awl on core rejuvenation piece
1
notch;truncated piece
1
notch-side scraper
1
notch-end scraper
1
flat burin
1
endscraper on truncated piece
1
double notch scraper
1
burin;scraper
1
burin-notch-scraper
1 rev(sort(table((tl4$`core-fragment`))))
pyramid rejuvenation piece
55 43
shapeless
33 27
core tablet NA
21 18
core fragment core preparation piece
15 14
bullet flat
10 5
primary flake mixed
3 3
prismatic core preperation
2 2
core on flake rejuvenation piece-side
2 1
pyramid-percussion primary blade
1 1
multidirectional flake core multidirectional core fragment
1 1
multidirectional bladelet core mixed-percussion
1 1
crested bladelet core preparation piece-platform
1 1
core platform rejuvention core fragment-pyramid
1 1
bipolar-percussion
1 # Exploring data
tl4 %>%
# BM: we need this because of the mutate_all ifelse combo you have above
mutate(midpoint = parse_number(midpoint)) %>%
group_by(midpoint) %>%
tally() %>%
drop_na(midpoint) %>%
ggplot() +
aes(midpoint, n) +
geom_col()
# refine the table
tl_final <- tl4 %>%
rename(
blank = Blank2,
`sickle shine` = shine2,
length = `Length (mm)` ,
width = `Width (mm)`,
thickness = `Thickness (mm)`,
typology = Typology,
utilization = Utilization,
retouch = Retouch,
blank = Blank2,
`blank part` = `Blank_part`,
`bulb thickness` = `Bulb Thickness (mm)`,
`platform thickness` = `Platform Thickness (mm)`,
`platform length` = `platform Length (mm)`,
eraillure = Eraillure ,
cortex = `Cortex (%)`) %>%
mutate(al = paste0(toupper(area), "_", layer)) %>%
relocate(al, .after = layer) %>%
select(lithic_id,
TA,
area,
layer,
al,
cortex,
depth, upper, lower, midpoint,
`length`, `width`, `thickness`,
typology,
utilization,
`sickle shine`,
retouch,
`typology-tool-core`,
`tool-typology`,
blank, `blank part`,
`core-typology`, `core-fragment`,`core-technology`,
cortex) %>%
# Update the 'typology-tool-core' column based on 'Retouch'
mutate(
`typology-tool-core` = case_when(
retouch == 1 ~ "tool",
utilization == 1 ~ "tool",
`sickle shine` == 1 ~ "tool",
TRUE ~ `typology-tool-core`
)
) %>%
mutate(
`tool-typology` = case_when(
utilization == 1 ~ "utilized tool",
`sickle shine` == 1 ~ "sickle shine",
TRUE ~ `tool-typology`
)
) %>%
mutate(
`tool-typology` = case_when(
# If Retouch is 1 and tool-typology is NA
retouch == 1 & is.na(`tool-typology`) ~ "retouched piece",
`sickle shine` == 1 & is.na(`tool-typology`) ~ "sickle shine",
# For all other cases
TRUE ~ `tool-typology`
)
)
# BM: take a look at tool typology
rev(sort(table(tl_final$`tool-typology`)))
utilized tool
360
retouched piece
112
notch
81
double side scraper
37
denticulate
36
side scraper
34
sickle shine
25
perforator-drill
19
serrated scraper
17
perforator-borer
17
end scraper
12
backed knife
10
truncated piece
9
perforator-awl
8
burin
8
double notch
7
perforator-point
6
convergent scraper
5
microburin
4
backed knife-naturally backed knife
4
used
3
round scraper
3
notch-denticulate
3
geometric-triangle
3
perforator-borer;denticulate
2
geometric-lunate
2
core tool-used core fragment
2
core preparation piece
2
backed;denticulate
2
truncated piece;notch
1
truncated piece-notch
1
transverse scraper
1
scraper-on core piece
1
scraper-convergent scraper
1
round scraper;notch
1
round scraper on core tablet
1
psedulevalois flake
1
perforator-point;notch
1
perforator-borer; preform
1
perforator-awl;notch
1
perforator-awl on core rejuvenation piece
1
notch;truncated piece
1
notch-side scraper
1
notch-end scraper
1
flat burin
1
endscraper on truncated piece
1
double notch scraper
1
burin;scraper
1
burin-notch-scraper
1 # List of columns that should be numeric
columns_to_convert <- c("cortex",
"upper",
"lower",
"midpoint",
"length",
"width",
"utilization",
"retouch",
"sickle shine")
# Convert each column to numeric
for (col_name in columns_to_convert) {
# Replace non-numeric characters with NA
# BM: this is quite an unusual method for doing this,
# where did you find it?
tl_final[[col_name]][tl_final[[col_name]] %in% c("", "NA", "N/A")] <- NA
# Convert to numeric
tl_final[[col_name]] <- as.numeric(tl_final[[col_name]])
}
# BM: this is how I would convert those columns to numeric,
# I think it's easier to read and requires less typing
# tl_final %>%
# mutate(across(all_of(columns_to_convert), parse_number))
# check the structure to see if they have been converted
str(tl_final)tibble [3,917 × 24] (S3: tbl_df/tbl/data.frame)
$ lithic_id : chr [1:3917] "1" "2" "3" "4" ...
$ TA : chr [1:3917] "ta/34" "ta/34" "ta/34" "ta/34" ...
$ area : chr [1:3917] "ta" "ta" "ta" "ta" ...
$ layer : chr [1:3917] "e" "e" "e" "e" ...
$ al : chr [1:3917] "TA_e" "TA_e" "TA_e" "TA_e" ...
$ cortex : num [1:3917] 0 0 0 0 0 0 0 0 10 0 ...
$ depth : chr [1:3917] "30-40cm" "30-40cm" "30-40cm" "30-40cm" ...
$ upper : num [1:3917] 30 30 30 30 30 30 30 30 30 30 ...
$ lower : num [1:3917] 40 40 40 40 40 40 40 40 40 40 ...
$ midpoint : num [1:3917] 35 35 35 35 35 35 35 35 35 35 ...
$ length : num [1:3917] 34.5 18.5 17 15.5 15 11 23 23 33 37 ...
$ width : num [1:3917] 12.7 10.7 7.6 5.8 6.2 7.6 7.7 5 13.7 11.5 ...
$ thickness : chr [1:3917] "3.1" "1.2" "1.4" "1.1" ...
$ typology : chr [1:3917] NA NA NA NA ...
$ utilization : num [1:3917] 1 1 NA NA NA NA NA NA 1 NA ...
$ sickle shine : num [1:3917] NA NA NA NA NA NA NA NA NA NA ...
$ retouch : num [1:3917] NA NA NA NA NA NA NA 1 NA NA ...
$ typology-tool-core: chr [1:3917] "tool" "tool" NA NA ...
$ tool-typology : chr [1:3917] "utilized tool" "utilized tool" NA NA ...
$ blank : chr [1:3917] "blade" "bladelet" "bladelet" "bladelet" ...
$ blank part : chr [1:3917] "complete" "med" "complete" "pro" ...
$ core-typology : chr [1:3917] NA NA NA NA ...
$ core-fragment : chr [1:3917] NA NA NA NA ...
$ core-technology : chr [1:3917] NA NA NA NA ...#set the value of utilization to NA only for the rows where `sickle shine` == 1.
tl_final <- tl_final %>%
rowwise() %>%
mutate(utilization = ifelse(is.na(`sickle shine`) | is.na(utilization), utilization,
ifelse(`sickle shine` == 1 & utilization == 1, NA_real_, utilization))) %>%
ungroup()#number of `sickle shine` in clumn `sickle shine`=1 and tooltypegroup are not match:
rev(sort(table(tl_final$tooltypegroup)))integer(0)rev(sort(table(tl_final$`sickle shine`))) 1
56 #troubleshoot:
tl_final %>% filter(`sickle shine` == 1) %>%
select(`tool-typology`,
`sickle shine`)# A tibble: 56 × 2
`tool-typology` `sickle shine`
<chr> <dbl>
1 utilized tool 1
2 utilized tool 1
3 sickle shine 1
4 utilized tool 1
5 utilized tool 1
6 utilized tool 1
7 sickle shine 1
8 sickle shine 1
9 sickle shine 1
10 utilized tool 1
# ℹ 46 more rowstl_final %>% filter(`tool-typology` == "sickle shine") %>%
select(`tool-typology`, `sickle shine`)# A tibble: 25 × 2
`tool-typology` `sickle shine`
<chr> <dbl>
1 sickle shine 1
2 sickle shine 1
3 sickle shine 1
4 sickle shine 1
5 sickle shine 1
6 sickle shine 1
7 sickle shine 1
8 sickle shine 1
9 sickle shine 1
10 sickle shine 1
# ℹ 15 more rowstl_final <- tl_final %>%
mutate(
`tool-typology` = case_when(
`sickle shine` == 1 ~ "sickle shine",
utilization == 1 ~ "utilized tool",
TRUE ~ `tool-typology`
)
)
rev(sort(table(tl_final$`tool-typology`)))
utilized tool
329
retouched piece
112
notch
81
sickle shine
56
double side scraper
37
denticulate
36
side scraper
34
perforator-drill
19
serrated scraper
17
perforator-borer
17
end scraper
12
backed knife
10
truncated piece
9
perforator-awl
8
burin
8
double notch
7
perforator-point
6
convergent scraper
5
microburin
4
backed knife-naturally backed knife
4
used
3
round scraper
3
notch-denticulate
3
geometric-triangle
3
perforator-borer;denticulate
2
geometric-lunate
2
core tool-used core fragment
2
core preparation piece
2
backed;denticulate
2
truncated piece;notch
1
truncated piece-notch
1
transverse scraper
1
scraper-on core piece
1
scraper-convergent scraper
1
round scraper;notch
1
round scraper on core tablet
1
psedulevalois flake
1
perforator-point;notch
1
perforator-borer; preform
1
perforator-awl;notch
1
perforator-awl on core rejuvenation piece
1
notch;truncated piece
1
notch-side scraper
1
notch-end scraper
1
flat burin
1
endscraper on truncated piece
1
double notch scraper
1
burin;scraper
1
burin-notch-scraper
1 # Creating tooltypegroup
tl_final <- tl_final %>%
mutate(
tooltypegroup = case_when(
`tool-typology` %in%
c(
"end scraper",
"side scraper",
"double side scraper",
"convergent scraper",
"round scraper",
"perforator-convergent scraper",
"perforator-borer; preform",
"scraper-on core piece",
"endscraper on truncated piece",
"round scraper",
"transverse scraper",
"core tool-used core fragment",
"round scraper on core tablet"
) ~ "scraper",
`tool-typology` %in%
c(
"perforator-borer",
"perforator-drill",
"perforator-point",
"perforator-awl",
"perforator-point;notch",
"perforator-awl on core rejuvenation piece",
"perforator-awl;notch",
"perforator-borer;denticulate"
) ~ "Perforator",
`tool-typology` %in%
c(
"backed knife",
"backed knife-naturally backed knife",
"backed;denticulate"
) ~ "backed pieces",
`tool-typology` %in% c(
"double notch",
"denticulate",
" denticulate",
"notch-denticulate",
"notch"
) ~ "denticulate-notch",
`tool-typology` %in% c(
"notch-side scraper",
"notch-end scraper",
"double notch scraper",
"round scraper;notch"
) ~ "scraper-notch",
`tool-typology` %in% c("geometric-triangle", "geometric-lunate") ~ "geometric",
`tool-typology` == "serrated scraper" ~ "serrated scraper",
`tool-typology` %in% c(
"truncated piece",
"truncated piece-notch",
"truncated piece;notch",
"notch;truncated piece"
) ~ "truncated pieces",
# Represents NA group
`tool-typology` %in% c("core preparation piece", "used", "psedulevalois flake") ~ NA_character_,
`tool-typology` %in% c("burin", "flat burin", "burin;scraper", "burin-notch-scraper") ~ "burin",
`tool-typology` == "microburin" ~ "microburin",
`tool-typology` == "retouched piece" ~ "retouched piece",
`tool-typology` == "utilized tool" ~ "utilized tool",
`tool-typology` == "sickle shine" ~ "sickle shine",
#classify any remaining values as NA
TRUE ~ NA_character_
)
)
# Checking the unique values of tooltypegroup
rev(sort(table(tl_final$tooltypegroup)))
utilized tool denticulate-notch retouched piece scraper
329 127 112 98
sickle shine Perforator serrated scraper backed pieces
56 55 17 16
truncated pieces burin geometric scraper-notch
12 11 5 4
microburin
4 library(dplyr)
library(stringr)
# Define the patterns to search for
patterns <- c("denticulate-notch", "retouched piece", "scraper",
"Perforator", "serrated scraper", "backed pieces",
"truncated pieces", "burin", "geometric", "scraper-notch",
"microburin")
# Update the `retouch` column based on the `tooltypegroup` column
tl_final <- tl_final %>%
mutate(retouch = ifelse(str_detect(tooltypegroup,
str_c(patterns, collapse = "|")),
1, retouch))
# View the first few rows to confirm
head(tl_final)# A tibble: 6 × 25
lithic_id TA area layer al cortex depth upper lower midpoint length
<chr> <chr> <chr> <chr> <chr> <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
1 1 ta/34 ta e TA_e 0 30-40cm 30 40 35 34.5
2 2 ta/34 ta e TA_e 0 30-40cm 30 40 35 18.5
3 3 ta/34 ta e TA_e 0 30-40cm 30 40 35 17
4 4 ta/34 ta e TA_e 0 30-40cm 30 40 35 15.5
5 5 ta/34 ta e TA_e 0 30-40cm 30 40 35 15
6 6 ta/34 ta e TA_e 0 30-40cm 30 40 35 11
# ℹ 14 more variables: width <dbl>, thickness <chr>, typology <chr>,
# utilization <dbl>, `sickle shine` <dbl>, retouch <dbl>,
# `typology-tool-core` <chr>, `tool-typology` <chr>, blank <chr>,
# `blank part` <chr>, `core-typology` <chr>, `core-fragment` <chr>,
# `core-technology` <chr>, tooltypegroup <chr>rev(sort(table(tl_final$tooltypegroup)))
utilized tool denticulate-notch retouched piece scraper
329 127 112 98
sickle shine Perforator serrated scraper backed pieces
56 55 17 16
truncated pieces burin geometric scraper-notch
12 11 5 4
microburin
4 rev(sort(table(tl_final$retouch))) 1
486 tl_final <- tl_final %>%
mutate(`core-fragment` = if_else(!is.na(`core-typology`),
NA_character_,
`core-fragment`)) %>%
mutate(`core-fragment` = if_else(!is.na(`core-typology`),
NA_character_,
`core-fragment`)) %>%
mutate(
`core-fragment` = case_when(
`core-fragment` == "rejuvenation piece" ~ "rejuvenation piece",
`core-fragment` == "rejuvention piece-side" ~ "rejuvenation piece",
`core-fragment` == "core preparation piece-platform" ~ "core tablet",
`core-fragment` == "core preparation" ~ "rejuvenation piece",
`core-fragment` == "core preparation piece" ~ "rejuvenation piece",
`core-fragment` == "core preperation" ~ "rejuvenation piece",
`core-fragment` == "pyramid" ~ "pyramid",
`core-fragment` == "pyramid core" ~ "pyramid",
`core-fragment` == "pyramid-unidirectional" ~ "pyramid",
`core-fragment` == "core fragment-pyramid" ~ "pyramid",
`core-fragment` == "cylinder" ~ "cylinder/prismatic",
`core-fragment` == "prismatic" ~ "cylinder/prismatic",
`core-fragment` == "shapeless" ~ "cylinder/prismatic",
`core-fragment` == "multidirectional core fragment" ~ "shapeless",
`core-fragment` == "multidirectional flake core" ~ "shapeless",
`core-fragment` == "multidirectional bladelet core" ~ "shapeless",
`core-fragment` == "mixed core" ~ "shapeless",
`core-fragment` == "mixed-percussion" ~ "shapeless",
`core-fragment` == "mixed" ~ "shapeless",
`core-fragment` == ("bipolar-percussion") ~ "bipolar",
`core-fragment` == "flat" ~ "flat",
`core-fragment` == "core on flake" ~ "core on flake",
`core-fragment` == "bullet" ~ "bullet",
TRUE ~ `core-fragment`
)
) %>%
mutate(
core = case_when(
`core-fragment` %in% c(
"pyramid",
"pyramid core",
"pyramid-unidirectional",
"core fragment-pyramid",
"cylinder/prismatic",
"shapeless",
"multidirectional core fragment",
"multidirectional flake core",
"multidirectional bladelet core",
"mixed core",
"mixed-percussion",
"mixed",
"bipolar-percussion",
"flat",
"core on flake",
"bullet"
) ~ `core-fragment`,
TRUE ~ NA_character_
),
corefrag = case_when(
`core-fragment` %in% c(
"rejuvenation piece",
"rejuvention piece-side",
"core preparation piece-platform",
"core preparation",
"core preparation piece",
"core preperation",
"crested bladelet" ,
"primary flake" ,
"primary blade"
) ~ `core-fragment`,
TRUE ~ NA_character_
)
) %>%
# Convert empty strings to NA in `core-fragment` column
mutate(`core-fragment` = if_else(`core-fragment` == "", NA_character_, `core-fragment`)) %>%
# Convert "pyramid-percussion" to "pyramid" in `core-fragment` column
mutate(
`core-fragment` =
if_else(
`core-fragment` == "pyramid-percussion",
"pyramid",
`core-fragment`
)
) %>%
# Update existing `core` column with selected values from `core-fragment` column
mutate(core = if_else(
`core-fragment` %in%
c(
"pyramid",
"cylinder/prismatic",
"flat",
"bullet",
"core on flake",
"pyramid"
),
`core-fragment`,
core
)) %>%
# Add 'core tablet' and 'core fragment' from `core-fragment` to `corefrag`
mutate(
corefrag = case_when(
`core-fragment` == "core tablet" ~ "core tablet",
`core-fragment` == "core fragment" ~ "core fragment",
TRUE ~ corefrag
)
) %>%
# Transfer 'rejuvenation piece' and 'core fragment' from `core-typology` to `corefrag`
mutate(
corefrag = case_when(
`core-typology` == "rejuvenation piece" ~ "rejuvenation piece",
`core-typology` == "core fragment" ~ "core fragment",
TRUE ~ corefrag
)
) %>%
# Remove 'rejuvenation piece' and 'core fragment' from `core-typology`
mutate(`core-typology` = if_else(
`core-typology` %in% c("rejuvenation piece", "core fragment"),
NA_character_,
`core-typology`
)) %>%
# Update the 'blank' column based on conditions in the 'core-fragment' column
mutate(blank = if_else(
`core-fragment` %in% c(
"core fragment",
"core tablet",
"rejuvenation piece",
"pyramid",
"crested bladelet",
"shapeless",
"primary flake",
"flat",
"bullet",
"core on flake",
"cylinder/prismatic",
"primary blade",
"rejuvenation piece-side",
"core platform rejuvention"
),
NA_character_,
blank
))
# take a look
rev(sort(table(tl_final$core)))
pyramid shapeless bullet flat
45 7 5 4
cylinder/prismatic core on flake
2 2 rev(sort(table(tl_final$corefrag)))
rejuvenation piece core tablet core fragment primary flake
58 22 8 3
primary blade crested bladelet
1 1 rev(sort(table(tl_final$`core-fragment`)))
rejuvenation piece pyramid core tablet
56 45 22
NA shapeless core fragment
18 7 7
bullet flat primary flake
5 4 3
cylinder/prismatic core on flake rejuvenation piece-side
2 2 1
primary blade crested bladelet core platform rejuvention
1 1 1
bipolar
1 rev(sort(table(tl_final$blank)))
bladelet blade flake
2630 833 190 library(dplyr)
# Filter the data to include only the areas 'ta', 'd1', and 'tp1'
tl_final_area <- tl_final %>%
filter(area %in% c("ta", "d1", "tp1"))Summary tables: 1. AREA
# Create a summary table
summary_table_area <- tl_final %>%
group_by(area) %>%
summarise(
`Cores (n)` = sum(!is.na(core) & core != ""),
`Core rejuvenations pieces (n)` = sum(!is.na(corefrag) &
corefrag != ""),
`Blade (n)` = sum(blank == "blade", na.rm = TRUE),
`Flake (n)` = sum(blank == "flake", na.rm = TRUE),
`Bladelet (n)` = sum(blank == "bladelet", na.rm = TRUE),
`Retouched Tools (n)` = sum(retouch == 1, na.rm = TRUE),
`Utilized (n)` = sum(utilization == 1, na.rm = TRUE),
`Sickle Shine (n)` = sum(`sickle shine` == 1, na.rm = TRUE)
)
# BM: looks like this is area and layer, is that right? I see c1, d1, d2, d3, d4 etc.
# SS: those are different excavated areas, we mainly consider ta, tp1, and d1.
knitr::kable(summary_table_area)| area | Cores (n) | Core rejuvenations pieces (n) | Blade (n) | Flake (n) | Bladelet (n) | Retouched Tools (n) | Utilized (n) | Sickle Shine (n) |
|---|---|---|---|---|---|---|---|---|
| b | 2 | 1 | 1 | 0 | 0 | 0 | 0 | 0 |
| c | 0 | 0 | 3 | 1 | 0 | 1 | 0 | 0 |
| c1 | 0 | 0 | 4 | 0 | 2 | 2 | 0 | 0 |
| d1 | 5 | 4 | 33 | 5 | 109 | 21 | 5 | 1 |
| d3 | 0 | 0 | 8 | 1 | 20 | 6 | 5 | 0 |
| d4 | 1 | 0 | 8 | 1 | 13 | 2 | 3 | 0 |
| d5 | 0 | 0 | 1 | 0 | 1 | 1 | 1 | 0 |
| dh | 0 | 0 | 3 | 0 | 6 | 1 | 0 | 0 |
| surface | 6 | 0 | 12 | 2 | 14 | 6 | 1 | 1 |
| ta | 51 | 80 | 708 | 151 | 2246 | 408 | 282 | 48 |
| tp1 | 0 | 8 | 52 | 29 | 219 | 38 | 32 | 6 |
library(kableExtra)
kable(summary_table_area,
caption = "Table: Summary by Area",
align = 'c') %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = F,
font_size = 12) %>%
row_spec(0, bold = TRUE, font_size = 14)| area | Cores (n) | Core rejuvenations pieces (n) | Blade (n) | Flake (n) | Bladelet (n) | Retouched Tools (n) | Utilized (n) | Sickle Shine (n) |
|---|---|---|---|---|---|---|---|---|
| b | 2 | 1 | 1 | 0 | 0 | 0 | 0 | 0 |
| c | 0 | 0 | 3 | 1 | 0 | 1 | 0 | 0 |
| c1 | 0 | 0 | 4 | 0 | 2 | 2 | 0 | 0 |
| d1 | 5 | 4 | 33 | 5 | 109 | 21 | 5 | 1 |
| d3 | 0 | 0 | 8 | 1 | 20 | 6 | 5 | 0 |
| d4 | 1 | 0 | 8 | 1 | 13 | 2 | 3 | 0 |
| d5 | 0 | 0 | 1 | 0 | 1 | 1 | 1 | 0 |
| dh | 0 | 0 | 3 | 0 | 6 | 1 | 0 | 0 |
| surface | 6 | 0 | 12 | 2 | 14 | 6 | 1 | 1 |
| ta | 51 | 80 | 708 | 151 | 2246 | 408 | 282 | 48 |
| tp1 | 0 | 8 | 52 | 29 | 219 | 38 | 32 | 6 |
2.LAYER
# Create a summary table
summary_table_layer <- tl_final %>%
group_by(layer) %>%
summarise(
`Cores (n)` = sum(!is.na(core)), # Count non-NA core entries
`Core rejuvenations pieces (n)` = sum(!is.na(corefrag)), # Count non-NA corefrag entries
`Blade (n)` = sum(blank == "blade", na.rm = TRUE),
`Flake (n)` = sum(blank == "flake", na.rm = TRUE),
`Bladelet (n)` = sum(blank == "bladelet", na.rm = TRUE),
`Retouched Tools (n)` = sum(retouch == 1, na.rm = TRUE),
`Utilized (n)` = sum(utilization == 1, na.rm = TRUE),
`Sickle Shine (n)` = sum(`sickle shine` == 1, na.rm = TRUE)
)# Generate the table
kable(summary_table_layer,
caption = "Table: Summary by Layer",
align = 'c') %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = F,
font_size = 12) %>%
row_spec(0, bold = TRUE, font_size = 14)| layer | Cores (n) | Core rejuvenations pieces (n) | Blade (n) | Flake (n) | Bladelet (n) | Retouched Tools (n) | Utilized (n) | Sickle Shine (n) |
|---|---|---|---|---|---|---|---|---|
| a | 1 | 2 | 21 | 0 | 57 | 9 | 1 | 0 |
| c | 4 | 9 | 63 | 34 | 266 | 47 | 36 | 7 |
| d | 29 | 44 | 465 | 123 | 1309 | 239 | 152 | 27 |
| e | 22 | 36 | 243 | 28 | 937 | 169 | 130 | 21 |
| NA | 9 | 2 | 41 | 5 | 61 | 22 | 10 | 1 |
AREA-LAYER:
# Create a summary table based on the 'al' column
summary_table_al <- tl_final %>%
group_by(al) %>%
summarise(
`Cores (n)` = sum(!is.na(core)),
`Core rejuvenations pieces (n)` = sum(!is.na(corefrag)),
`Blade (n)` = sum(blank == "blade", na.rm = TRUE),
`Flake (n)` = sum(blank == "flake", na.rm = TRUE),
`Bladelet (n)` = sum(blank == "bladelet", na.rm = TRUE),
`Retouched Tools (n)` = sum(retouch == 1, na.rm = TRUE),
`Utilized (n)` = sum(utilization == 1, na.rm = TRUE),
`Sickle Shine (n)` = sum(`sickle shine` == 1, na.rm = TRUE)
)# Generate the table
kable(summary_table_al,
caption = "Table: Summary by Al",
align = 'c') %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = F,
font_size = 12) %>%
row_spec(0, bold = TRUE, font_size = 14)| al | Cores (n) | Core rejuvenations pieces (n) | Blade (n) | Flake (n) | Bladelet (n) | Retouched Tools (n) | Utilized (n) | Sickle Shine (n) |
|---|---|---|---|---|---|---|---|---|
| B_NA | 2 | 1 | 1 | 0 | 0 | 0 | 0 | 0 |
| C1_NA | 0 | 0 | 4 | 0 | 2 | 2 | 0 | 0 |
| C_NA | 0 | 0 | 3 | 1 | 0 | 1 | 0 | 0 |
| D1_NA | 0 | 0 | 0 | 0 | 1 | 1 | 0 | 0 |
| D1_a | 1 | 2 | 21 | 0 | 57 | 9 | 1 | 0 |
| D1_c | 4 | 2 | 12 | 5 | 51 | 11 | 4 | 1 |
| D3_NA | 0 | 0 | 8 | 1 | 20 | 6 | 5 | 0 |
| D4_NA | 1 | 0 | 8 | 1 | 13 | 2 | 3 | 0 |
| D5_NA | 0 | 0 | 1 | 0 | 1 | 1 | 1 | 0 |
| DH_NA | 0 | 0 | 3 | 0 | 6 | 1 | 0 | 0 |
| SURFACE_NA | 6 | 0 | 12 | 2 | 14 | 6 | 1 | 1 |
| TA_d | 29 | 44 | 465 | 123 | 1309 | 239 | 152 | 27 |
| TA_e | 22 | 36 | 243 | 28 | 937 | 169 | 130 | 21 |
| TP1_NA | 0 | 1 | 1 | 0 | 4 | 2 | 0 | 0 |
| TP1_c | 0 | 7 | 51 | 29 | 215 | 36 | 32 | 6 |
Techno-Typo:
# Prepare data for Summary table-area
summary_table_area <- tl_final %>%
filter(area %in% c("ta", "d1", "tp1")) %>%
group_by(area) %>%
summarise(
blade_count = sum(blank == "blade", na.rm = TRUE),
flake_count = sum(blank == "flake", na.rm = TRUE),
bladelet_count = sum(blank == "bladelet", na.rm = TRUE),
tool_count = sum(retouch == 1, na.rm = TRUE) + sum(utilization == 1, na.rm = TRUE),
core_count = sum(!is.na(`core-typology`), na.rm = TRUE),
core_rejuvenation_count = sum(!is.na(`corefrag`), na.rm = TRUE),
retouched_tool_count = sum(retouch == 1, na.rm = TRUE),
utilized_tool_count = sum(utilization == 1, na.rm = TRUE),
shine_tool_count = sum(`sickle shine` == 1, na.rm = TRUE),
total = n()
)
summary_table_area <- summary_table_area %>%
add_row(
area = "Total",
blade_count = sum(.$blade_count, na.rm = TRUE),
flake_count = sum(.$flake_count, na.rm = TRUE),
bladelet_count = sum(.$bladelet_count, na.rm = TRUE),
tool_count = sum(.$tool_count, na.rm = TRUE),
core_count = sum(.$core_count, na.rm = TRUE),
core_rejuvenation_count = sum(.$core_rejuvenation_count, na.rm = TRUE),
retouched_tool_count = sum(.$retouched_tool_count, na.rm = TRUE),
utilized_tool_count = sum(.$utilized_tool_count, na.rm = TRUE),
shine_tool_count = sum(.$shine_tool_count, na.rm = TRUE),
total = sum(.$total, na.rm = TRUE) # Explicitly setting the total
)
# Adding a new row with total counts
summary_table_area <- summary_table_area %>%
add_row(
area = "Total",
blade_count = sum(.$blade_count, na.rm = TRUE),
flake_count = sum(.$flake_count, na.rm = TRUE),
bladelet_count = sum(.$bladelet_count, na.rm = TRUE),
tool_count = sum(.$tool_count, na.rm = TRUE),
core_count = sum(.$core_count, na.rm = TRUE),
core_rejuvenation_count = sum(.$core_rejuvenation_count, na.rm = TRUE),
retouched_tool_count = sum(.$retouched_tool_count, na.rm = TRUE),
utilized_tool_count = sum(.$utilized_tool_count, na.rm = TRUE),
shine_tool_count = sum(.$shine_tool_count, na.rm = TRUE),
total = sum(.$total, na.rm = TRUE) # Explicitly setting the total
)# Prepare data for Summary table-area_layer(al)
summary_table_al <- tl_final %>%
filter(area %in% c("ta", "d1", "tp1")) %>%
group_by(al) %>%
summarise(
blade_count = sum(blank == "blade", na.rm = TRUE),
flake_count = sum(blank == "flake", na.rm = TRUE),
bladelet_count = sum(blank == "bladelet", na.rm = TRUE),
tool_count = sum(retouch == 1, na.rm = TRUE) + sum(utilization == 1, na.rm = TRUE),
core_count = sum(!is.na(`core-typology`), na.rm = TRUE),
core_rejuvenation_count = sum(!is.na(`corefrag`), na.rm = TRUE),
retouched_tool_count = sum(retouch == 1, na.rm = TRUE),
utilized_tool_count = sum(utilization == 1, na.rm = TRUE),
shine_tool_count = sum(`sickle shine` == 1, na.rm = TRUE),
total = n()
)
# Adding a new row with total counts
summary_table_al <- summary_table_al %>%
add_row(
al = "Total",
blade_count = sum(.$blade_count, na.rm = TRUE),
flake_count = sum(.$flake_count, na.rm = TRUE),
bladelet_count = sum(.$bladelet_count, na.rm = TRUE),
tool_count = sum(.$tool_count, na.rm = TRUE),
core_count = sum(.$core_count, na.rm = TRUE),
core_rejuvenation_count = sum(.$core_rejuvenation_count, na.rm = TRUE),
retouched_tool_count = sum(.$retouched_tool_count, na.rm = TRUE),
utilized_tool_count = sum(.$utilized_tool_count, na.rm = TRUE),
shine_tool_count = sum(.$shine_tool_count, na.rm = TRUE),
total = sum(.$total, na.rm = TRUE)
)
rev(sort(table(tl_final$tooltypegroup)))
utilized tool denticulate-notch retouched piece scraper
329 127 112 98
sickle shine Perforator serrated scraper backed pieces
56 55 17 16
truncated pieces burin geometric scraper-notch
12 11 5 4
microburin
4 #explore tool type group
summary_table_tooltype <- tl_final %>%
filter(tooltypegroup != 'utilized tool') %>% # Exclude 'utilized tool'
group_by(tooltypegroup) %>%
summarise(
)#generate a table
summary_table_al <- summary_table_al %>%
filter(!(al %in% c("D1_NA", "TP1_NA")))
kable(
summary_table_al,
col.names = c(
"Area-Layer",
"Blade",
"Flake",
"Bladelet",
"Tools",
"Cores",
"Core Rejuvenations",
"Retouched Tools",
"Utilized Tools",
"Sickle Shine",
"Total"
),
caption = "Table: Summary ",
align = 'c'
) %>%
kable_styling(
bootstrap_options = c("striped",
"hover",
"condensed"),
full_width = FALSE,
font_size = 12
) %>%
row_spec(0,
bold = TRUE,
font_size = 14)| Area-Layer | Blade | Flake | Bladelet | Tools | Cores | Core Rejuvenations | Retouched Tools | Utilized Tools | Sickle Shine | Total |
|---|---|---|---|---|---|---|---|---|---|---|
| D1_a | 21 | 0 | 57 | 10 | 0 | 2 | 9 | 1 | 0 | 81 |
| D1_c | 12 | 5 | 51 | 15 | 1 | 2 | 11 | 4 | 1 | 75 |
| TA_d | 465 | 123 | 1309 | 391 | 51 | 44 | 239 | 152 | 27 | 2031 |
| TA_e | 243 | 28 | 937 | 299 | 38 | 36 | 169 | 130 | 21 | 1301 |
| TP1_c | 51 | 29 | 215 | 68 | 2 | 7 | 36 | 32 | 6 | 306 |
| Total | 793 | 185 | 2574 | 786 | 92 | 92 | 467 | 319 | 55 | 3802 |
# Create a summary table for typology based on area
summary_table_tool_area <- tl_final %>%
filter(area %in% c("ta", "d1", "tp1")) %>%
filter(!is.na(tooltypegroup), tooltypegroup != "") %>% # Exclude rows where 'tooltypegroup' is NA or empty
group_by(area, tooltypegroup) %>% # Group the data by area and tooltypegroup
tally() %>% # Count the number of rows in each group
arrange(area, tooltypegroup) %>% # Arrange by area and tooltypegroup
spread(key = area, value = n, fill = 0) # Spread the 'area' column into multiple columns
# Add a "Total" column that sums each row
summary_table_tool_area <- summary_table_tool_area %>%
mutate(Total = rowSums(select(.,-tooltypegroup)))
total_row <- summary_table_tool_area %>%
select(-tooltypegroup) %>%
summarise(across(everything(), \(x) sum(x, na.rm = TRUE))) %>%
mutate(tooltypegroup = "Total")
summary_table_tool_area <-
bind_rows(summary_table_tool_area, total_row)kable(
summary_table_tool_area,
col.names = c("Tools", "D1", "TA", "TP1", "Total"),
caption = "Table: Tool Typology in three different main areas.",
align = 'c'
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed"),
full_width = F,
font_size = 12
) %>%
column_spec(1, extra_css = "text-align:left;") %>%
row_spec(0, bold = TRUE, font_size = 14)| Tools | D1 | TA | TP1 | Total |
|---|---|---|---|---|
| backed pieces | 0 | 11 | 2 | 13 |
| burin | 2 | 8 | 1 | 11 |
| denticulate-notch | 4 | 110 | 7 | 121 |
| geometric | 3 | 2 | 0 | 5 |
| microburin | 0 | 4 | 0 | 4 |
| Perforator | 2 | 50 | 2 | 54 |
| retouched piece | 5 | 89 | 15 | 109 |
| scraper | 4 | 84 | 6 | 94 |
| scraper-notch | 0 | 4 | 0 | 4 |
| serrated scraper | 0 | 15 | 1 | 16 |
| sickle shine | 1 | 48 | 6 | 55 |
| truncated pieces | 1 | 10 | 0 | 11 |
| utilized tool | 5 | 282 | 32 | 319 |
| Total | 27 | 717 | 72 | 816 |
# Create the summary table based on layer
summary_table1_layer <- tl_final %>%
filter(area %in% c("ta", "d1", "tp1")) %>%
group_by(layer) %>%
summarise(
numb_retouched = sum(retouch == 1, na.rm = TRUE),
numb_cores = sum(!is.na(`core-typology`), na.rm = TRUE),
total_lithics = n(),
percent_retouch = round((numb_retouched / total_lithics) * 100, 2)
)# Create a summary table based on the 'depth', 'area', and 'layer' columns
tl_final <- tl_final %>%
mutate(depth = gsub("cm", "", depth))
summary_table_depth_area_layer <- tl_final %>%
group_by(TA, depth, area, layer, upper, lower) %>%
summarise(
`Cores (n)` = sum(!is.na(core)),
`Core rejuvenations pieces (n)` = sum(!is.na(corefrag)),
`Blade (n)` = sum(blank == "blade", na.rm = TRUE),
`Flake (n)` = sum(blank == "flake", na.rm = TRUE),
`Bladelet (n)` = sum(blank == "bladelet", na.rm = TRUE),
`Retouched Tools (n)` = sum(retouch == 1, na.rm = TRUE),
`Utilized (n)` = sum(utilization == 1, na.rm = TRUE),
`Sickle Shine (n)` = sum(`sickle shine` == 1, na.rm = TRUE)
)
# Generate the table
library(kableExtra)
kable(summary_table_depth_area_layer,
caption = "Table: Summary by Depth, Area, and Layer",
align = 'c') %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = F,
font_size = 12) %>%
row_spec(0, bold = TRUE, font_size = 14)| TA | depth | area | layer | upper | lower | Cores (n) | Core rejuvenations pieces (n) | Blade (n) | Flake (n) | Bladelet (n) | Retouched Tools (n) | Utilized (n) | Sickle Shine (n) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| b/1 | 0-10 | b | NA | 0 | 10 | 2 | 1 | 1 | 0 | 0 | 0 | 0 | 0 |
| c/01 | 0-10 | c | NA | 0 | 10 | 0 | 0 | 3 | 1 | 0 | 1 | 0 | 0 |
| c1/02 | 0-20 | c1 | NA | 0 | 20 | 0 | 0 | 4 | 0 | 2 | 2 | 0 | 0 |
| d1/02 | 0-20 | d1 | c | 0 | 20 | 4 | 2 | 12 | 5 | 50 | 11 | 4 | 1 |
| d1/23 | 20-30 | d1 | c | 20 | 30 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 |
| d1/46 | 40-60 | d1 | a | 40 | 60 | 0 | 1 | 6 | 0 | 32 | 4 | 0 | 0 |
| d1/56 | 50-60 | d1 | a | 50 | 60 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 |
| d1/67 | 60-70 | d1 | a | 60 | 70 | 1 | 1 | 14 | 0 | 19 | 5 | 0 | 0 |
| d1/78 | 70-80 | d1 | a | 70 | 80 | 0 | 0 | 1 | 0 | 5 | 0 | 1 | 0 |
| d1/all | NA | d1 | NA | NA | NA | 0 | 0 | 0 | 0 | 1 | 1 | 0 | 0 |
| d3/02 | 0-20 | d3 | NA | 0 | 20 | 0 | 0 | 8 | 1 | 20 | 6 | 5 | 0 |
| d4/02 | 0-20 | d4 | NA | 0 | 20 | 1 | 0 | 8 | 1 | 13 | 2 | 3 | 0 |
| d5/01 | 0-10 | d5 | NA | 0 | 10 | 0 | 0 | 1 | 0 | 1 | 1 | 1 | 0 |
| dh/12 | 10-20 | dh | NA | 10 | 20 | 0 | 0 | 3 | 0 | 6 | 1 | 0 | 0 |
| surface | NA | surface | NA | NA | NA | 6 | 0 | 12 | 2 | 14 | 6 | 1 | 1 |
| ta/125 | 120-150 | ta | d | 120 | 150 | 0 | 13 | 97 | 27 | 204 | 46 | 24 | 3 |
| ta/158 | 150-180 | ta | d | 150 | 180 | 18 | 12 | 98 | 37 | 338 | 63 | 25 | 4 |
| ta/189 | 180-190 | ta | d | 180 | 190 | 0 | 3 | 39 | 13 | 115 | 29 | 13 | 2 |
| ta/190 | 190-200 | ta | d | 190 | 200 | 0 | 1 | 38 | 7 | 88 | 17 | 10 | 0 |
| ta/201 | 200-210 | ta | d | 200 | 210 | 1 | 5 | 22 | 7 | 72 | 9 | 11 | 4 |
| ta/212 | 210-220 | ta | d | 210 | 220 | 0 | 2 | 6 | 5 | 60 | 2 | 9 | 0 |
| ta/223 | 220-230 | ta | d | 220 | 230 | 0 | 0 | 18 | 1 | 47 | 2 | 13 | 2 |
| ta/234 | 230-240 | ta | d | 230 | 240 | 2 | 2 | 23 | 10 | 80 | 12 | 13 | 1 |
| ta/235 | 230-250 | ta | d | 230 | 250 | 2 | 1 | 4 | 0 | 5 | 0 | 0 | 0 |
| ta/235/f1 | 230-250 | ta | d | 230 | 250 | 0 | 0 | 8 | 1 | 16 | 3 | 1 | 0 |
| ta/256 | 250-260 | ta | d | 250 | 260 | 6 | 2 | 60 | 7 | 102 | 24 | 15 | 4 |
| ta/267 | 260-270 | ta | d | 260 | 270 | 0 | 3 | 13 | 1 | 68 | 5 | 6 | 0 |
| ta/3 | 0-30 | ta | e | 0 | 30 | 1 | 11 | 66 | 8 | 275 | 39 | 46 | 9 |
| ta/34 | 30-40 | ta | e | 30 | 40 | 3 | 9 | 54 | 2 | 232 | 47 | 27 | 2 |
| ta/45 | 40-50 | ta | e | 40 | 50 | 9 | 6 | 61 | 5 | 249 | 31 | 28 | 5 |
| ta/56 | 50-60 | ta | e | 50 | 60 | 4 | 3 | 52 | 6 | 160 | 32 | 22 | 3 |
| ta/67 | 60-70 | ta | e | 60 | 70 | 5 | 7 | 10 | 7 | 21 | 20 | 7 | 2 |
| ta/72 | 70-120 | ta | d | 70 | 120 | 0 | 0 | 39 | 7 | 114 | 27 | 12 | 7 |
| tp1/01 | 0-10 | tp1 | c | 0 | 10 | 0 | 2 | 20 | 8 | 85 | 19 | 19 | 4 |
| tp1/101 | 100-110 | tp1 | c | 100 | 110 | 0 | 0 | 0 | 0 | 3 | 0 | 0 | 0 |
| tp1/112 | 110-120 | tp1 | c | 110 | 120 | 0 | 0 | 2 | 0 | 1 | 0 | 0 | 0 |
| tp1/123 | 120-130 | tp1 | c | 120 | 130 | 0 | 0 | 0 | 0 | 2 | 0 | 0 | 0 |
| tp1/124 | 120-140 | tp1 | c | 120 | 140 | 0 | 0 | 0 | 1 | 6 | 2 | 0 | 0 |
| tp1/13 | 10-30 | tp1 | c | 10 | 30 | 0 | 0 | 2 | 2 | 12 | 0 | 3 | 0 |
| tp1/19 | 10-90 | tp1 | c | 10 | 90 | 0 | 0 | 0 | 0 | 4 | 0 | 1 | 0 |
| tp1/2 | 0-20 | tp1 | c | 0 | 20 | 0 | 1 | 2 | 0 | 4 | 1 | 0 | 0 |
| tp1/23 | 20-30 | tp1 | c | 20 | 30 | 0 | 0 | 1 | 0 | 2 | 0 | 1 | 0 |
| tp1/34 | 30-40 | tp1 | c | 30 | 40 | 0 | 2 | 0 | 6 | 4 | 0 | 0 | 0 |
| tp1/45 | 40-50 | tp1 | c | 40 | 50 | 0 | 0 | 3 | 6 | 12 | 4 | 2 | 0 |
| tp1/51 | 50-100 | tp1 | c | 50 | 100 | 0 | 0 | 2 | 0 | 8 | 0 | 0 | 0 |
| tp1/557 | 557 | tp1 | NA | 557 | NA | 0 | 0 | 0 | 0 | 1 | 1 | 0 | 0 |
| tp1/56 | 50-60 | tp1 | c | 50 | 60 | 0 | 1 | 2 | 5 | 5 | 1 | 0 | 0 |
| tp1/57 | 50-70 | tp1 | c | 50 | 70 | 0 | 1 | 10 | 0 | 47 | 8 | 6 | 2 |
| tp1/667 | 667 | tp1 | NA | 667 | NA | 0 | 1 | 1 | 0 | 3 | 1 | 0 | 0 |
| tp1/89 | 80-90 | tp1 | c | 80 | 90 | 0 | 0 | 3 | 0 | 5 | 0 | 0 | 0 |
| tp1/90 | 90-100 | tp1 | c | 90 | 100 | 0 | 0 | 4 | 1 | 11 | 1 | 0 | 0 |
| tp1/91 | 90-100 | tp1 | c | 90 | 100 | 0 | 0 | 0 | 0 | 4 | 0 | 0 | 0 |
# Generate a summary table by grouping by 'depth' and 'area'
summary_table_depth_tool_type <- tl_final %>%
group_by(area, depth) %>%
summarise(tool_type = n_distinct(tooltypegroup, na.rm = TRUE), .groups = 'drop')
# Create a full summary table by joining it back to the original summary table based on 'depth' and 'area'
summary_table_depth_area_layer <- summary_table_depth_area_layer %>%
left_join(summary_table_depth_tool_type, by = c("area", "depth"))
# Remove the existing 'tool_type' if it exists
if ("tool_type" %in% names(summary_table_depth_area_layer)) {
summary_table_depth_area_layer <- summary_table_depth_area_layer %>%
select(-tool_type)
}
# Join again based on 'depth', this time being specific about what we want
summary_table_depth_area_layer <-
summary_table_depth_area_layer %>%
left_join(summary_table_depth_tool_type %>% select(depth, tool_type),
by = "depth")
# Generate the table
library(kableExtra)
kable(summary_table_depth_area_layer,
caption = "Table: Summary by Depth, Area, and Layer",
align = 'c') %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = F,
font_size = 12) %>%
row_spec(0, bold = TRUE, font_size = 14)| TA | depth | area | layer | upper | lower | Cores (n) | Core rejuvenations pieces (n) | Blade (n) | Flake (n) | Bladelet (n) | Retouched Tools (n) | Utilized (n) | Sickle Shine (n) | tool_type |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| b/1 | 0-10 | b | NA | 0 | 10 | 2 | 1 | 1 | 0 | 0 | 0 | 0 | 0 | 0 |
| b/1 | 0-10 | b | NA | 0 | 10 | 2 | 1 | 1 | 0 | 0 | 0 | 0 | 0 | 1 |
| b/1 | 0-10 | b | NA | 0 | 10 | 2 | 1 | 1 | 0 | 0 | 0 | 0 | 0 | 2 |
| b/1 | 0-10 | b | NA | 0 | 10 | 2 | 1 | 1 | 0 | 0 | 0 | 0 | 0 | 7 |
| c/01 | 0-10 | c | NA | 0 | 10 | 0 | 0 | 3 | 1 | 0 | 1 | 0 | 0 | 0 |
| c/01 | 0-10 | c | NA | 0 | 10 | 0 | 0 | 3 | 1 | 0 | 1 | 0 | 0 | 1 |
| c/01 | 0-10 | c | NA | 0 | 10 | 0 | 0 | 3 | 1 | 0 | 1 | 0 | 0 | 2 |
| c/01 | 0-10 | c | NA | 0 | 10 | 0 | 0 | 3 | 1 | 0 | 1 | 0 | 0 | 7 |
| c1/02 | 0-20 | c1 | NA | 0 | 20 | 0 | 0 | 4 | 0 | 2 | 2 | 0 | 0 | 2 |
| c1/02 | 0-20 | c1 | NA | 0 | 20 | 0 | 0 | 4 | 0 | 2 | 2 | 0 | 0 | 8 |
| c1/02 | 0-20 | c1 | NA | 0 | 20 | 0 | 0 | 4 | 0 | 2 | 2 | 0 | 0 | 4 |
| c1/02 | 0-20 | c1 | NA | 0 | 20 | 0 | 0 | 4 | 0 | 2 | 2 | 0 | 0 | 3 |
| c1/02 | 0-20 | c1 | NA | 0 | 20 | 0 | 0 | 4 | 0 | 2 | 2 | 0 | 0 | 1 |
| d1/02 | 0-20 | d1 | c | 0 | 20 | 4 | 2 | 12 | 5 | 50 | 11 | 4 | 1 | 2 |
| d1/02 | 0-20 | d1 | c | 0 | 20 | 4 | 2 | 12 | 5 | 50 | 11 | 4 | 1 | 8 |
| d1/02 | 0-20 | d1 | c | 0 | 20 | 4 | 2 | 12 | 5 | 50 | 11 | 4 | 1 | 4 |
| d1/02 | 0-20 | d1 | c | 0 | 20 | 4 | 2 | 12 | 5 | 50 | 11 | 4 | 1 | 3 |
| d1/02 | 0-20 | d1 | c | 0 | 20 | 4 | 2 | 12 | 5 | 50 | 11 | 4 | 1 | 1 |
| d1/23 | 20-30 | d1 | c | 20 | 30 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 |
| d1/23 | 20-30 | d1 | c | 20 | 30 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 1 |
| d1/46 | 40-60 | d1 | a | 40 | 60 | 0 | 1 | 6 | 0 | 32 | 4 | 0 | 0 | 2 |
| d1/56 | 50-60 | d1 | a | 50 | 60 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 |
| d1/56 | 50-60 | d1 | a | 50 | 60 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 7 |
| d1/56 | 50-60 | d1 | a | 50 | 60 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 1 |
| d1/67 | 60-70 | d1 | a | 60 | 70 | 1 | 1 | 14 | 0 | 19 | 5 | 0 | 0 | 3 |
| d1/67 | 60-70 | d1 | a | 60 | 70 | 1 | 1 | 14 | 0 | 19 | 5 | 0 | 0 | 7 |
| d1/78 | 70-80 | d1 | a | 70 | 80 | 0 | 0 | 1 | 0 | 5 | 0 | 1 | 0 | 1 |
| d1/all | NA | d1 | NA | NA | NA | 0 | 0 | 0 | 0 | 1 | 1 | 0 | 0 | 1 |
| d1/all | NA | d1 | NA | NA | NA | 0 | 0 | 0 | 0 | 1 | 1 | 0 | 0 | 6 |
| d3/02 | 0-20 | d3 | NA | 0 | 20 | 0 | 0 | 8 | 1 | 20 | 6 | 5 | 0 | 2 |
| d3/02 | 0-20 | d3 | NA | 0 | 20 | 0 | 0 | 8 | 1 | 20 | 6 | 5 | 0 | 8 |
| d3/02 | 0-20 | d3 | NA | 0 | 20 | 0 | 0 | 8 | 1 | 20 | 6 | 5 | 0 | 4 |
| d3/02 | 0-20 | d3 | NA | 0 | 20 | 0 | 0 | 8 | 1 | 20 | 6 | 5 | 0 | 3 |
| d3/02 | 0-20 | d3 | NA | 0 | 20 | 0 | 0 | 8 | 1 | 20 | 6 | 5 | 0 | 1 |
| d4/02 | 0-20 | d4 | NA | 0 | 20 | 1 | 0 | 8 | 1 | 13 | 2 | 3 | 0 | 2 |
| d4/02 | 0-20 | d4 | NA | 0 | 20 | 1 | 0 | 8 | 1 | 13 | 2 | 3 | 0 | 8 |
| d4/02 | 0-20 | d4 | NA | 0 | 20 | 1 | 0 | 8 | 1 | 13 | 2 | 3 | 0 | 4 |
| d4/02 | 0-20 | d4 | NA | 0 | 20 | 1 | 0 | 8 | 1 | 13 | 2 | 3 | 0 | 3 |
| d4/02 | 0-20 | d4 | NA | 0 | 20 | 1 | 0 | 8 | 1 | 13 | 2 | 3 | 0 | 1 |
| d5/01 | 0-10 | d5 | NA | 0 | 10 | 0 | 0 | 1 | 0 | 1 | 1 | 1 | 0 | 0 |
| d5/01 | 0-10 | d5 | NA | 0 | 10 | 0 | 0 | 1 | 0 | 1 | 1 | 1 | 0 | 1 |
| d5/01 | 0-10 | d5 | NA | 0 | 10 | 0 | 0 | 1 | 0 | 1 | 1 | 1 | 0 | 2 |
| d5/01 | 0-10 | d5 | NA | 0 | 10 | 0 | 0 | 1 | 0 | 1 | 1 | 1 | 0 | 7 |
| dh/12 | 10-20 | dh | NA | 10 | 20 | 0 | 0 | 3 | 0 | 6 | 1 | 0 | 0 | 1 |
| surface | NA | surface | NA | NA | NA | 6 | 0 | 12 | 2 | 14 | 6 | 1 | 1 | 1 |
| surface | NA | surface | NA | NA | NA | 6 | 0 | 12 | 2 | 14 | 6 | 1 | 1 | 6 |
| ta/125 | 120-150 | ta | d | 120 | 150 | 0 | 13 | 97 | 27 | 204 | 46 | 24 | 3 | 11 |
| ta/158 | 150-180 | ta | d | 150 | 180 | 18 | 12 | 98 | 37 | 338 | 63 | 25 | 4 | 12 |
| ta/189 | 180-190 | ta | d | 180 | 190 | 0 | 3 | 39 | 13 | 115 | 29 | 13 | 2 | 12 |
| ta/190 | 190-200 | ta | d | 190 | 200 | 0 | 1 | 38 | 7 | 88 | 17 | 10 | 0 | 7 |
| ta/201 | 200-210 | ta | d | 200 | 210 | 1 | 5 | 22 | 7 | 72 | 9 | 11 | 4 | 6 |
| ta/212 | 210-220 | ta | d | 210 | 220 | 0 | 2 | 6 | 5 | 60 | 2 | 9 | 0 | 3 |
| ta/223 | 220-230 | ta | d | 220 | 230 | 0 | 0 | 18 | 1 | 47 | 2 | 13 | 2 | 4 |
| ta/234 | 230-240 | ta | d | 230 | 240 | 2 | 2 | 23 | 10 | 80 | 12 | 13 | 1 | 7 |
| ta/235 | 230-250 | ta | d | 230 | 250 | 2 | 1 | 4 | 0 | 5 | 0 | 0 | 0 | 3 |
| ta/235/f1 | 230-250 | ta | d | 230 | 250 | 0 | 0 | 8 | 1 | 16 | 3 | 1 | 0 | 3 |
| ta/256 | 250-260 | ta | d | 250 | 260 | 6 | 2 | 60 | 7 | 102 | 24 | 15 | 4 | 8 |
| ta/267 | 260-270 | ta | d | 260 | 270 | 0 | 3 | 13 | 1 | 68 | 5 | 6 | 0 | 4 |
| ta/3 | 0-30 | ta | e | 0 | 30 | 1 | 11 | 66 | 8 | 275 | 39 | 46 | 9 | 7 |
| ta/34 | 30-40 | ta | e | 30 | 40 | 3 | 9 | 54 | 2 | 232 | 47 | 27 | 2 | 9 |
| ta/34 | 30-40 | ta | e | 30 | 40 | 3 | 9 | 54 | 2 | 232 | 47 | 27 | 2 | 0 |
| ta/45 | 40-50 | ta | e | 40 | 50 | 9 | 6 | 61 | 5 | 249 | 31 | 28 | 5 | 7 |
| ta/45 | 40-50 | ta | e | 40 | 50 | 9 | 6 | 61 | 5 | 249 | 31 | 28 | 5 | 4 |
| ta/56 | 50-60 | ta | e | 50 | 60 | 4 | 3 | 52 | 6 | 160 | 32 | 22 | 3 | 0 |
| ta/56 | 50-60 | ta | e | 50 | 60 | 4 | 3 | 52 | 6 | 160 | 32 | 22 | 3 | 7 |
| ta/56 | 50-60 | ta | e | 50 | 60 | 4 | 3 | 52 | 6 | 160 | 32 | 22 | 3 | 1 |
| ta/67 | 60-70 | ta | e | 60 | 70 | 5 | 7 | 10 | 7 | 21 | 20 | 7 | 2 | 3 |
| ta/67 | 60-70 | ta | e | 60 | 70 | 5 | 7 | 10 | 7 | 21 | 20 | 7 | 2 | 7 |
| ta/72 | 70-120 | ta | d | 70 | 120 | 0 | 0 | 39 | 7 | 114 | 27 | 12 | 7 | 9 |
| tp1/01 | 0-10 | tp1 | c | 0 | 10 | 0 | 2 | 20 | 8 | 85 | 19 | 19 | 4 | 0 |
| tp1/01 | 0-10 | tp1 | c | 0 | 10 | 0 | 2 | 20 | 8 | 85 | 19 | 19 | 4 | 1 |
| tp1/01 | 0-10 | tp1 | c | 0 | 10 | 0 | 2 | 20 | 8 | 85 | 19 | 19 | 4 | 2 |
| tp1/01 | 0-10 | tp1 | c | 0 | 10 | 0 | 2 | 20 | 8 | 85 | 19 | 19 | 4 | 7 |
| tp1/101 | 100-110 | tp1 | c | 100 | 110 | 0 | 0 | 0 | 0 | 3 | 0 | 0 | 0 | 0 |
| tp1/112 | 110-120 | tp1 | c | 110 | 120 | 0 | 0 | 2 | 0 | 1 | 0 | 0 | 0 | 0 |
| tp1/123 | 120-130 | tp1 | c | 120 | 130 | 0 | 0 | 0 | 0 | 2 | 0 | 0 | 0 | 0 |
| tp1/124 | 120-140 | tp1 | c | 120 | 140 | 0 | 0 | 0 | 1 | 6 | 2 | 0 | 0 | 2 |
| tp1/13 | 10-30 | tp1 | c | 10 | 30 | 0 | 0 | 2 | 2 | 12 | 0 | 3 | 0 | 1 |
| tp1/19 | 10-90 | tp1 | c | 10 | 90 | 0 | 0 | 0 | 0 | 4 | 0 | 1 | 0 | 1 |
| tp1/2 | 0-20 | tp1 | c | 0 | 20 | 0 | 1 | 2 | 0 | 4 | 1 | 0 | 0 | 2 |
| tp1/2 | 0-20 | tp1 | c | 0 | 20 | 0 | 1 | 2 | 0 | 4 | 1 | 0 | 0 | 8 |
| tp1/2 | 0-20 | tp1 | c | 0 | 20 | 0 | 1 | 2 | 0 | 4 | 1 | 0 | 0 | 4 |
| tp1/2 | 0-20 | tp1 | c | 0 | 20 | 0 | 1 | 2 | 0 | 4 | 1 | 0 | 0 | 3 |
| tp1/2 | 0-20 | tp1 | c | 0 | 20 | 0 | 1 | 2 | 0 | 4 | 1 | 0 | 0 | 1 |
| tp1/23 | 20-30 | tp1 | c | 20 | 30 | 0 | 0 | 1 | 0 | 2 | 0 | 1 | 0 | 0 |
| tp1/23 | 20-30 | tp1 | c | 20 | 30 | 0 | 0 | 1 | 0 | 2 | 0 | 1 | 0 | 1 |
| tp1/34 | 30-40 | tp1 | c | 30 | 40 | 0 | 2 | 0 | 6 | 4 | 0 | 0 | 0 | 9 |
| tp1/34 | 30-40 | tp1 | c | 30 | 40 | 0 | 2 | 0 | 6 | 4 | 0 | 0 | 0 | 0 |
| tp1/45 | 40-50 | tp1 | c | 40 | 50 | 0 | 0 | 3 | 6 | 12 | 4 | 2 | 0 | 7 |
| tp1/45 | 40-50 | tp1 | c | 40 | 50 | 0 | 0 | 3 | 6 | 12 | 4 | 2 | 0 | 4 |
| tp1/51 | 50-100 | tp1 | c | 50 | 100 | 0 | 0 | 2 | 0 | 8 | 0 | 0 | 0 | 0 |
| tp1/557 | 557 | tp1 | NA | 557 | NA | 0 | 0 | 0 | 0 | 1 | 1 | 0 | 0 | 1 |
| tp1/56 | 50-60 | tp1 | c | 50 | 60 | 0 | 1 | 2 | 5 | 5 | 1 | 0 | 0 | 0 |
| tp1/56 | 50-60 | tp1 | c | 50 | 60 | 0 | 1 | 2 | 5 | 5 | 1 | 0 | 0 | 7 |
| tp1/56 | 50-60 | tp1 | c | 50 | 60 | 0 | 1 | 2 | 5 | 5 | 1 | 0 | 0 | 1 |
| tp1/57 | 50-70 | tp1 | c | 50 | 70 | 0 | 1 | 10 | 0 | 47 | 8 | 6 | 2 | 4 |
| tp1/667 | 667 | tp1 | NA | 667 | NA | 0 | 1 | 1 | 0 | 3 | 1 | 0 | 0 | 1 |
| tp1/89 | 80-90 | tp1 | c | 80 | 90 | 0 | 0 | 3 | 0 | 5 | 0 | 0 | 0 | 0 |
| tp1/90 | 90-100 | tp1 | c | 90 | 100 | 0 | 0 | 4 | 1 | 11 | 1 | 0 | 0 | 1 |
| tp1/91 | 90-100 | tp1 | c | 90 | 100 | 0 | 0 | 0 | 0 | 4 | 0 | 0 | 0 | 1 |
# Specify the exact columns want to keep
desired_columns <- c("TA", "depth", "area", "layer", "upper", "lower",
"Cores (n)", "Core rejuvenations pieces (n)",
"Blade (n)", "Flake (n)", "Bladelet (n)",
"Retouched Tools (n)", "Utilized (n)", "Sickle Shine (n)",
"tool_type") # Only keep this 'tool_type'
# Filter the tl_final dataframe
summary_table_depth_area_layer <- summary_table_depth_area_layer %>%
filter(area %in% c('ta', 'd1', 'tp1'))
# Generate the table
library(kableExtra)
kable(summary_table_depth_area_layer,
caption = "Table: Summary by Depth, Area, and Layer",
align = 'c') %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = F,
font_size = 12) %>%
row_spec(0, bold = TRUE, font_size = 14)| TA | depth | area | layer | upper | lower | Cores (n) | Core rejuvenations pieces (n) | Blade (n) | Flake (n) | Bladelet (n) | Retouched Tools (n) | Utilized (n) | Sickle Shine (n) | tool_type |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| d1/02 | 0-20 | d1 | c | 0 | 20 | 4 | 2 | 12 | 5 | 50 | 11 | 4 | 1 | 2 |
| d1/02 | 0-20 | d1 | c | 0 | 20 | 4 | 2 | 12 | 5 | 50 | 11 | 4 | 1 | 8 |
| d1/02 | 0-20 | d1 | c | 0 | 20 | 4 | 2 | 12 | 5 | 50 | 11 | 4 | 1 | 4 |
| d1/02 | 0-20 | d1 | c | 0 | 20 | 4 | 2 | 12 | 5 | 50 | 11 | 4 | 1 | 3 |
| d1/02 | 0-20 | d1 | c | 0 | 20 | 4 | 2 | 12 | 5 | 50 | 11 | 4 | 1 | 1 |
| d1/23 | 20-30 | d1 | c | 20 | 30 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 |
| d1/23 | 20-30 | d1 | c | 20 | 30 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 1 |
| d1/46 | 40-60 | d1 | a | 40 | 60 | 0 | 1 | 6 | 0 | 32 | 4 | 0 | 0 | 2 |
| d1/56 | 50-60 | d1 | a | 50 | 60 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 |
| d1/56 | 50-60 | d1 | a | 50 | 60 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 7 |
| d1/56 | 50-60 | d1 | a | 50 | 60 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 1 |
| d1/67 | 60-70 | d1 | a | 60 | 70 | 1 | 1 | 14 | 0 | 19 | 5 | 0 | 0 | 3 |
| d1/67 | 60-70 | d1 | a | 60 | 70 | 1 | 1 | 14 | 0 | 19 | 5 | 0 | 0 | 7 |
| d1/78 | 70-80 | d1 | a | 70 | 80 | 0 | 0 | 1 | 0 | 5 | 0 | 1 | 0 | 1 |
| d1/all | NA | d1 | NA | NA | NA | 0 | 0 | 0 | 0 | 1 | 1 | 0 | 0 | 1 |
| d1/all | NA | d1 | NA | NA | NA | 0 | 0 | 0 | 0 | 1 | 1 | 0 | 0 | 6 |
| ta/125 | 120-150 | ta | d | 120 | 150 | 0 | 13 | 97 | 27 | 204 | 46 | 24 | 3 | 11 |
| ta/158 | 150-180 | ta | d | 150 | 180 | 18 | 12 | 98 | 37 | 338 | 63 | 25 | 4 | 12 |
| ta/189 | 180-190 | ta | d | 180 | 190 | 0 | 3 | 39 | 13 | 115 | 29 | 13 | 2 | 12 |
| ta/190 | 190-200 | ta | d | 190 | 200 | 0 | 1 | 38 | 7 | 88 | 17 | 10 | 0 | 7 |
| ta/201 | 200-210 | ta | d | 200 | 210 | 1 | 5 | 22 | 7 | 72 | 9 | 11 | 4 | 6 |
| ta/212 | 210-220 | ta | d | 210 | 220 | 0 | 2 | 6 | 5 | 60 | 2 | 9 | 0 | 3 |
| ta/223 | 220-230 | ta | d | 220 | 230 | 0 | 0 | 18 | 1 | 47 | 2 | 13 | 2 | 4 |
| ta/234 | 230-240 | ta | d | 230 | 240 | 2 | 2 | 23 | 10 | 80 | 12 | 13 | 1 | 7 |
| ta/235 | 230-250 | ta | d | 230 | 250 | 2 | 1 | 4 | 0 | 5 | 0 | 0 | 0 | 3 |
| ta/235/f1 | 230-250 | ta | d | 230 | 250 | 0 | 0 | 8 | 1 | 16 | 3 | 1 | 0 | 3 |
| ta/256 | 250-260 | ta | d | 250 | 260 | 6 | 2 | 60 | 7 | 102 | 24 | 15 | 4 | 8 |
| ta/267 | 260-270 | ta | d | 260 | 270 | 0 | 3 | 13 | 1 | 68 | 5 | 6 | 0 | 4 |
| ta/3 | 0-30 | ta | e | 0 | 30 | 1 | 11 | 66 | 8 | 275 | 39 | 46 | 9 | 7 |
| ta/34 | 30-40 | ta | e | 30 | 40 | 3 | 9 | 54 | 2 | 232 | 47 | 27 | 2 | 9 |
| ta/34 | 30-40 | ta | e | 30 | 40 | 3 | 9 | 54 | 2 | 232 | 47 | 27 | 2 | 0 |
| ta/45 | 40-50 | ta | e | 40 | 50 | 9 | 6 | 61 | 5 | 249 | 31 | 28 | 5 | 7 |
| ta/45 | 40-50 | ta | e | 40 | 50 | 9 | 6 | 61 | 5 | 249 | 31 | 28 | 5 | 4 |
| ta/56 | 50-60 | ta | e | 50 | 60 | 4 | 3 | 52 | 6 | 160 | 32 | 22 | 3 | 0 |
| ta/56 | 50-60 | ta | e | 50 | 60 | 4 | 3 | 52 | 6 | 160 | 32 | 22 | 3 | 7 |
| ta/56 | 50-60 | ta | e | 50 | 60 | 4 | 3 | 52 | 6 | 160 | 32 | 22 | 3 | 1 |
| ta/67 | 60-70 | ta | e | 60 | 70 | 5 | 7 | 10 | 7 | 21 | 20 | 7 | 2 | 3 |
| ta/67 | 60-70 | ta | e | 60 | 70 | 5 | 7 | 10 | 7 | 21 | 20 | 7 | 2 | 7 |
| ta/72 | 70-120 | ta | d | 70 | 120 | 0 | 0 | 39 | 7 | 114 | 27 | 12 | 7 | 9 |
| tp1/01 | 0-10 | tp1 | c | 0 | 10 | 0 | 2 | 20 | 8 | 85 | 19 | 19 | 4 | 0 |
| tp1/01 | 0-10 | tp1 | c | 0 | 10 | 0 | 2 | 20 | 8 | 85 | 19 | 19 | 4 | 1 |
| tp1/01 | 0-10 | tp1 | c | 0 | 10 | 0 | 2 | 20 | 8 | 85 | 19 | 19 | 4 | 2 |
| tp1/01 | 0-10 | tp1 | c | 0 | 10 | 0 | 2 | 20 | 8 | 85 | 19 | 19 | 4 | 7 |
| tp1/101 | 100-110 | tp1 | c | 100 | 110 | 0 | 0 | 0 | 0 | 3 | 0 | 0 | 0 | 0 |
| tp1/112 | 110-120 | tp1 | c | 110 | 120 | 0 | 0 | 2 | 0 | 1 | 0 | 0 | 0 | 0 |
| tp1/123 | 120-130 | tp1 | c | 120 | 130 | 0 | 0 | 0 | 0 | 2 | 0 | 0 | 0 | 0 |
| tp1/124 | 120-140 | tp1 | c | 120 | 140 | 0 | 0 | 0 | 1 | 6 | 2 | 0 | 0 | 2 |
| tp1/13 | 10-30 | tp1 | c | 10 | 30 | 0 | 0 | 2 | 2 | 12 | 0 | 3 | 0 | 1 |
| tp1/19 | 10-90 | tp1 | c | 10 | 90 | 0 | 0 | 0 | 0 | 4 | 0 | 1 | 0 | 1 |
| tp1/2 | 0-20 | tp1 | c | 0 | 20 | 0 | 1 | 2 | 0 | 4 | 1 | 0 | 0 | 2 |
| tp1/2 | 0-20 | tp1 | c | 0 | 20 | 0 | 1 | 2 | 0 | 4 | 1 | 0 | 0 | 8 |
| tp1/2 | 0-20 | tp1 | c | 0 | 20 | 0 | 1 | 2 | 0 | 4 | 1 | 0 | 0 | 4 |
| tp1/2 | 0-20 | tp1 | c | 0 | 20 | 0 | 1 | 2 | 0 | 4 | 1 | 0 | 0 | 3 |
| tp1/2 | 0-20 | tp1 | c | 0 | 20 | 0 | 1 | 2 | 0 | 4 | 1 | 0 | 0 | 1 |
| tp1/23 | 20-30 | tp1 | c | 20 | 30 | 0 | 0 | 1 | 0 | 2 | 0 | 1 | 0 | 0 |
| tp1/23 | 20-30 | tp1 | c | 20 | 30 | 0 | 0 | 1 | 0 | 2 | 0 | 1 | 0 | 1 |
| tp1/34 | 30-40 | tp1 | c | 30 | 40 | 0 | 2 | 0 | 6 | 4 | 0 | 0 | 0 | 9 |
| tp1/34 | 30-40 | tp1 | c | 30 | 40 | 0 | 2 | 0 | 6 | 4 | 0 | 0 | 0 | 0 |
| tp1/45 | 40-50 | tp1 | c | 40 | 50 | 0 | 0 | 3 | 6 | 12 | 4 | 2 | 0 | 7 |
| tp1/45 | 40-50 | tp1 | c | 40 | 50 | 0 | 0 | 3 | 6 | 12 | 4 | 2 | 0 | 4 |
| tp1/51 | 50-100 | tp1 | c | 50 | 100 | 0 | 0 | 2 | 0 | 8 | 0 | 0 | 0 | 0 |
| tp1/557 | 557 | tp1 | NA | 557 | NA | 0 | 0 | 0 | 0 | 1 | 1 | 0 | 0 | 1 |
| tp1/56 | 50-60 | tp1 | c | 50 | 60 | 0 | 1 | 2 | 5 | 5 | 1 | 0 | 0 | 0 |
| tp1/56 | 50-60 | tp1 | c | 50 | 60 | 0 | 1 | 2 | 5 | 5 | 1 | 0 | 0 | 7 |
| tp1/56 | 50-60 | tp1 | c | 50 | 60 | 0 | 1 | 2 | 5 | 5 | 1 | 0 | 0 | 1 |
| tp1/57 | 50-70 | tp1 | c | 50 | 70 | 0 | 1 | 10 | 0 | 47 | 8 | 6 | 2 | 4 |
| tp1/667 | 667 | tp1 | NA | 667 | NA | 0 | 1 | 1 | 0 | 3 | 1 | 0 | 0 | 1 |
| tp1/89 | 80-90 | tp1 | c | 80 | 90 | 0 | 0 | 3 | 0 | 5 | 0 | 0 | 0 | 0 |
| tp1/90 | 90-100 | tp1 | c | 90 | 100 | 0 | 0 | 4 | 1 | 11 | 1 | 0 | 0 | 1 |
| tp1/91 | 90-100 | tp1 | c | 90 | 100 | 0 | 0 | 0 | 0 | 4 | 0 | 0 | 0 | 1 |
#Here, I've imported the table 'Summary by Depth, Area, Layer' into Google Sheets for easier management.
#I thought this format would simplify the process of those depths needed to be splitting up.
# BM: looks like you need this data starting from around here in the document
library(tidyverse)
library(googlesheets4)
google_sheet_url <-
"https://docs.google.com/spreadsheets/d/1Q0QZESk412ZQLE24yPs6Rg-7Y9OMX63DHoXeIPNAIFM/edit#gid=0"
sum_depth_sheet <- read_sheet(google_sheet_url)
# Create the 'label' column
sum_depth_sheet <- sum_depth_sheet %>%
mutate(label = paste(area, layer, level, sep = "_"))
# Add a suffix only to duplicates
sum_depth_sheet <- sum_depth_sheet %>%
group_by(label) %>%
mutate(suffix = case_when(
n() == 1 ~ NA_character_,
TRUE ~ letters[row_number()]
)) %>%
ungroup()
# Append the suffix to 'label'
sum_depth_sheet <- sum_depth_sheet %>%
mutate(label = if_else(is.na(suffix), label, paste0(label, "_", suffix))) %>%
select(-suffix)
# Relocate 'label' column after 'level'
sum_depth_sheet <- sum_depth_sheet %>%
relocate(label, .after = level)
# BM: from my perspective, what would be ideal here is to have the
# excavation area and volume calculations done here in R. I feel anxious about
# the possibilities of typos when these values are calculated somewhere I can't
# see and pasted into the google sheet. I prefer for the workflow of calculations
# to be as transparent and traceable as possible. From this point in the qmd I
# think we can use the volume values from this google sheet. Another option is to
# export the google sheet as a CSV, and put that in the data folder in this project.
# Then we can use read_csv to import it.
#SS: is that true?: (I have a weird number in row 5, cl Depth and couldn't find out what happened)
#### previously I had a column'excavation area'; I seprated them in 2 columns in order to calculate the colume; but now when I wanted to run the code it said "! object 'excavation area' not found"; would it be OK to delete these lines?
# Separate `excavation area` into `length` and `width` and calculate `volume`
sum_depth_sheet <- sum_depth_sheet %>%
separate(`excavation area`, into = c("length", "width"), sep = "\\*") %>%
mutate(
length = as.numeric(length),
width = as.numeric(width),
`thickness` = `thickness` / 100 # Convert from cm to m
) %>%
mutate(
volume = length * width * `thickness` # Calculate volume in m^3
)
# Calculate lithic volumetric density
sum_depth_sheet <- sum_depth_sheet %>%
mutate(
`lithic_dens` = round(total_lithics / volume, 2)
)
# Calculate retouch frequency
sum_depth_sheet <- sum_depth_sheet %>%
mutate(
retouch_freq = round(retouch_tool / volume, 2)
)# Create the plot: WABI_Level_logscale
# here I do not consider those levels with a value 0 of retouch frequency.
filtered_data <- sum_depth_sheet %>%
filter(lithic_dens > 0 & retouch_freq > 0)
WABI_Level <- ggplot(filtered_data,
aes(x = lithic_dens,
y = retouch_freq)) +
geom_point(color = "black", size = 1.5) +
geom_smooth(method = "lm",
se = TRUE,
color = "blue",
linewidth = 0.5) +
# Add text labels based on 'label' column
geom_text(aes(label = label),
vjust = 1.5,
hjust = 0.5,
check_overlap = TRUE) +
stat_poly_eq(aes(label = paste(stat(eq.label),
stat(rr.label),
stat(p.value.label),
sep = "~~~")),
formula = y ~ x,
parse = TRUE,
size = 4) +
labs(
title = "Relationship between Retouch Frequency and Lithic Volumetric Density",
x = "Lithic Volumetric Density",
y = "Retouch Frequency"
) +
scale_x_log10() +
scale_y_log10() +
theme(
axis.text = element_text(size = 7),
axis.title = element_text(size = 10),
plot.title = element_text(size = 12)
)
# Print the plot to display it
print(WABI_Level)
#PCA_Level: preparing data
#PCA_level: for PCA Bicho and Cascalheira considered these variables: estimated area (as we calculated based on levels, I consider the thickness; is that OK?), core frequency, blank frequency, chip frequency: artefacts smaller than 1 cm (as we work on a neolithic asssemblage, we have so many small artefacts; so, I do not consider it), feature frequency (we have some stone alignments, but we do not know the exact level, we know the area of those features), retouch frequency, tool diversity (diversity of tool types within each assemblage, calculated using Menhinick’s index);
##core frequency
##blank frequency
##retouch frequency
##tool diversity
##thickness of deposit (???)
##lithic density
#Calculate Core Frequency
sum_depth_sheet <- sum_depth_sheet %>%
mutate(
core_freq = round(cores / volume, 2)
)
# calculate Blank Frequency
sum_depth_sheet <- sum_depth_sheet %>%
mutate(
blank_freq = round((flake + blade + bladelet) / volume, 2)
)
# Calculate tool diversity using Menhinick's index
sum_depth_sheet <- sum_depth_sheet %>%
mutate(
total_tools = retouch_tool + utilized + sickle_shine,
tool_diversity = ifelse(total_tools > 0, n_distinct(tool_type) / sqrt(total_tools), NA)
)pca_data <- sum_depth_sheet %>%
select(lithic_dens, core_freq, blank_freq, retouch_freq, tool_diversity) %>%
na.omit() # Remove rows with NA values# performin PCA
library(FactoMineR)
library(factoextra)
pca_data <- sum_depth_sheet[, c('lithic_dens', 'core_freq', 'blank_freq', 'retouch_freq', 'tool_diversity')]
# Perform PCA
res.pca <- PCA(pca_data, graph = FALSE)
# View the summary results
summary(res.pca)
Call:
PCA(X = pca_data, graph = FALSE)
Eigenvalues
Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
Variance 3.318 0.836 0.739 0.105 0.001
% of var. 66.367 16.721 14.781 2.109 0.023
Cumulative % of var. 66.367 83.088 97.868 99.977 100.000
Individuals (the 10 first)
Dist Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3
1 | 8.074 | 7.299 38.222 0.817 | 2.273 14.720 0.079 | -2.501
2 | 5.082 | 3.817 10.451 0.564 | -0.852 2.067 0.028 | 3.199
3 | 1.382 | -1.328 1.265 0.923 | -0.327 0.305 0.056 | -0.181
4 | 1.155 | 0.134 0.013 0.013 | -0.859 2.102 0.553 | -0.752
5 | 1.257 | -1.236 1.096 0.968 | 0.207 0.122 0.027 | -0.008
6 | 2.464 | -1.964 2.769 0.635 | 1.348 5.173 0.299 | 0.596
7 | 1.392 | -1.337 1.283 0.923 | -0.330 0.311 0.056 | -0.179
8 | 1.392 | -1.337 1.283 0.923 | -0.330 0.311 0.056 | -0.179
9 | 1.438 | -1.379 1.365 0.920 | -0.346 0.341 0.058 | -0.175
10 | 2.334 | -1.736 2.163 0.553 | 1.442 5.921 0.382 | 0.539
ctr cos2
1 20.149 0.096 |
2 32.976 0.396 |
3 0.105 0.017 |
4 1.822 0.424 |
5 0.000 0.000 |
6 1.143 0.058 |
7 0.104 0.017 |
8 0.104 0.017 |
9 0.098 0.015 |
10 0.935 0.053 |
Variables
Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr
lithic_dens | 0.977 28.753 0.954 | 0.178 3.809 0.032 | -0.068 0.625
core_freq | 0.583 10.228 0.339 | -0.275 9.023 0.075 | 0.764 78.918
blank_freq | 0.967 28.154 0.934 | 0.185 4.080 0.034 | -0.039 0.206
retouch_freq | 0.923 25.646 0.851 | 0.218 5.675 0.047 | -0.191 4.933
tool_diversity | -0.489 7.219 0.240 | 0.804 77.413 0.647 | 0.336 15.318
cos2
lithic_dens 0.005 |
core_freq 0.583 |
blank_freq 0.002 |
retouch_freq 0.036 |
tool_diversity 0.113 |#Plot: Contribution of variables for each of the four relevant PCA dimensions
library(factoextra)
library(ggplot2)
#save contribution plots into one objects
p1 <- fviz_contrib(res.pca,
choice = "var",
axes = 1,
top = 10)
p2 <- fviz_contrib(res.pca,
choice = "var",
axes = 2,
top = 10)
p3 <- fviz_contrib(res.pca,
choice = "var",
axes = 3,
top = 10)
p4 <- fviz_contrib(res.pca,
choice = "var",
axes = 4,
top = 10)
#combine individual plots into one plot
library(gridExtra)
grid.arrange(p1, p2, p3, p4, ncol = 2)
# Extract contributions of variables to each principal component
contributions <- res.pca$var$contrib
# Compute average contribution for each dimension
avg_contrib_dim1 <- mean(contributions[,1], na.rm = TRUE)
avg_contrib_dim2 <- mean(contributions[,2], na.rm = TRUE)
avg_contrib_dim3 <- mean(contributions[,3], na.rm = TRUE)
avg_contrib_dim4 <- mean(contributions[,4], na.rm = TRUE)
# Find variables that contribute more than average to each dimension
high_contrib_dim1 <- contributions[contributions[,1] > avg_contrib_dim1, 1]
high_contrib_dim2 <- contributions[contributions[,2] > avg_contrib_dim2, 2]
high_contrib_dim3 <- contributions[contributions[,3] > avg_contrib_dim3, 3]
high_contrib_dim4 <- contributions[contributions[,4] > avg_contrib_dim4, 4]
# Sort them in descending order
sorted_high_contrib_dim1 <- sort(high_contrib_dim1, decreasing = TRUE)
sorted_high_contrib_dim2 <- sort(high_contrib_dim2, decreasing = TRUE)
sorted_high_contrib_dim3 <- sort(high_contrib_dim3, decreasing = TRUE)
sorted_high_contrib_dim4 <- sort(high_contrib_dim4, decreasing = TRUE)
# Print or use for further analysis
print("Significant contributions to Dim1:")[1] "Significant contributions to Dim1:"print(sorted_high_contrib_dim1) lithic_dens blank_freq retouch_freq
28.75326 28.15377 25.64583 print("Significant contributions to Dim2:")[1] "Significant contributions to Dim2:"print(sorted_high_contrib_dim2)[1] 77.41307print("Significant contributions to Dim3:")[1] "Significant contributions to Dim3:"print(sorted_high_contrib_dim3)[1] 78.91811print("Significant contributions to Dim4:")[1] "Significant contributions to Dim4:"print(sorted_high_contrib_dim4)retouch_freq blank_freq
61.69980 28.14572 # screeplot; inspect distribution of PCs
library(factoextra)
fviz_screeplot(res.pca)
# Inspect eigenvalues
print(res.pca$eig) eigenvalue percentage of variance cumulative percentage of variance
comp 1 3.318338642 66.36677284 66.36677
comp 2 0.836040202 16.72080403 83.08758
comp 3 0.739034840 14.78069681 97.86827
comp 4 0.105453164 2.10906327 99.97734
comp 5 0.001133152 0.02266304 100.00000eigen_df <- data.frame(
eigenvalue = res.pca$eig[,1],
`percentage of variance` = res.pca$eig[,2],
`cumulative percentage of variance` = res.pca$eig[,3]
)library(kableExtra)
library(htmltools)
# Create a new column named "Dimension"
eigen_df$Dimension <- paste("Dim", seq_len(nrow(eigen_df)), sep = "")
# Re-order the columns based on the corrected names
eigen_df <- eigen_df[, c("Dimension", "eigenvalue", "percentage.of.variance", "cumulative.percentage.of.variance")]
# Round the numerical columns to 3 decimal places
eigen_df[, 2:4] <- round(eigen_df[, 2:4], 3)
# Removing row names
rownames(eigen_df) <- NULL
# Creating the kable output
kable_output <- kable(eigen_df,
"html",
align = 'c',
col.names = c("Dimension",
"Eigenvalue",
"Variance Percent",
"Cumulative Variance Percent")) %>%
kable_styling("striped",
full_width = F) %>%
add_header_above(c(" " = 1, "Eigenvalues and percentage of variance for each dimension of PCA" = 3))
# Display the table
htmltools::browsable(kable_output)| Dimension | Eigenvalue | Variance Percent | Cumulative Variance Percent |
|---|---|---|---|
| Dim1 | 3.318 | 66.367 | 66.367 |
| Dim2 | 0.836 | 16.721 | 83.088 |
| Dim3 | 0.739 | 14.781 | 97.868 |
| Dim4 | 0.105 | 2.109 | 99.977 |
| Dim5 | 0.001 | 0.023 | 100.000 |
# Visualize biplot:1
fviz_pca_biplot(res.pca,
axes = c(1, 2),
labelsize = 2
)
rownames(res.pca$ind$coord) <- sum_depth_sheet$label# Visualize biplot: 2
fviz_pca_biplot(res.pca,
axes = c(3, 4),
labelsize = 2
)
rownames(res.pca$ind$coord) <- sum_depth_sheet$label